X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..8d9cc0b7ea1893059df8788129998e9a71ec07f3:/lisp/progmodes/scheme.el diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 8f20438d05..e5fb8cbc7f 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,6 +1,7 @@ ;;; scheme.el --- Scheme (and DSSSL) editing mode -;; Copyright (C) 1986, 87, 88, 97, 1998 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1987, 1988, 1997, 1998, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007 Free Software Foundation, Inc. ;; Author: Bill Rozas ;; Adapted-by: Dave Love @@ -10,7 +11,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -20,8 +21,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -81,7 +82,7 @@ (modify-syntax-entry ?\n "> " st) (modify-syntax-entry ?\f " " st) (modify-syntax-entry ?\r " " st) - (modify-syntax-entry ? " " st) + (modify-syntax-entry ?\s " " st) ;; These characters are delimiters but otherwise undefined. ;; Brackets and braces balance for editing convenience. @@ -89,20 +90,26 @@ (modify-syntax-entry ?\] ")[ " st) (modify-syntax-entry ?{ "(} " st) (modify-syntax-entry ?} "){ " st) - (modify-syntax-entry ?\| " 23" st) + (modify-syntax-entry ?\| "\" 23bn" st) + ;; Guile allows #! ... !# comments. + ;; But SRFI-22 defines the comment as #!...\n instead. + ;; Also Guile says that the !# should be on a line of its own. + ;; It's too difficult to get it right, for too little benefit. + ;; (modify-syntax-entry ?! "_ 2" st) ;; Other atom delimiters (modify-syntax-entry ?\( "() " st) (modify-syntax-entry ?\) ")( " st) - (modify-syntax-entry ?\; "< " st) - (modify-syntax-entry ?\" "\" " st) + ;; It's used for single-line comments as well as for #;(...) sexp-comments. + (modify-syntax-entry ?\; "< 2 " 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 ?# "' 14b" st) (modify-syntax-entry ?\\ "\\ " st) st)) @@ -144,44 +151,43 @@ (setq outline-regexp ";;; \\|(....") (make-local-variable 'comment-start) (setq comment-start ";") + (set (make-local-variable 'comment-add) 1) (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]*") + (set (make-local-variable 'font-lock-comment-start-skip) ";+ *") (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 lisp-indent-function 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) (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)))) + (set (make-local-variable 'font-lock-defaults) + '((scheme-font-lock-keywords + scheme-font-lock-keywords-1 scheme-font-lock-keywords-2) + nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14")) + beginning-of-defun + (font-lock-mark-block-function . mark-defun) + (font-lock-syntactic-face-function + . scheme-font-lock-syntactic-face-function) + (parse-sexp-lookup-properties . t) + (font-lock-extra-managed-props syntax-table))) + (set (make-local-variable 'lisp-doc-string-elt-property) + 'scheme-doc-string-elt)) (defvar scheme-mode-line-process "") -(defvar scheme-mode-map nil - "Keymap for Scheme mode. -All commands in `lisp-mode-shared-map' are inherited by this map.") - -(unless scheme-mode-map - (let ((map (make-sparse-keymap "Scheme"))) - (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)) +(defvar scheme-mode-map + (let ((smap (make-sparse-keymap)) + (map (make-sparse-keymap "Scheme"))) + (set-keymap-parent smap lisp-mode-shared-map) + (define-key smap [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) @@ -192,7 +198,10 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") (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))) + (put 'indent-region 'menu-enable 'mark-active) + smap) + "Keymap for Scheme mode. +All commands in `lisp-mode-shared-map' are inherited by this map.") ;; Used by cmuscheme (defun scheme-mode-commands (map) @@ -222,17 +231,15 @@ Entry to this mode calls the value of `scheme-mode-hook' if that value is non-nil." (interactive) (kill-all-local-variables) - (scheme-mode-initialize) - (scheme-mode-variables) - (run-hooks 'scheme-mode-hook)) - -(defun scheme-mode-initialize () (use-local-map scheme-mode-map) (setq major-mode 'scheme-mode) - (setq mode-name "Scheme")) + (setq mode-name "Scheme") + (scheme-mode-variables) + (run-mode-hooks 'scheme-mode-hook)) (defgroup scheme nil - "Editing Scheme code" + "Editing Scheme code." + :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) :group 'lisp) (defcustom scheme-mit-dialect t @@ -328,25 +335,67 @@ See `run-hooks'." "do" "else" "for-each" "if" "lambda" "let" "let*" "let-syntax" "letrec" "letrec-syntax" ;; Hannes Haug wants: - "and" "or" "delay" + "and" "or" "delay" "force" ;; Stefan Monnier says don't bother: ;;"quasiquote" "quote" "unquote" "unquote-splicing" "map" "syntax" "syntax-rules") t) "\\>") 1) ;; + ;; It wouldn't be Scheme w/o named-let. + '("(let\\s-+\\(\\sw+\\)" + (1 font-lock-function-name-face)) + ;; ;; David Fox for SOS/STklos class specifiers. '("\\<<\\sw+>\\>" . font-lock-type-face) ;; - ;; Scheme `:' keywords as builtins. - '("\\<:\\sw+\\>" . font-lock-builtin-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.") +(defconst scheme-sexp-comment-syntax-table + (let ((st (make-syntax-table scheme-mode-syntax-table))) + (modify-syntax-entry ?\; "." st) + (modify-syntax-entry ?\n " " st) + (modify-syntax-entry ?# "'" st) + st)) + +(put 'lambda 'scheme-doc-string-elt 2) +;; Docstring's pos in a `define' depends on whether it's a var or fun def. +(put 'define 'scheme-doc-string-elt + (lambda () + ;; The function is called with point right after "define". + (forward-comment (point-max)) + (if (eq (char-after) ?\() 2 0))) + +(defun scheme-font-lock-syntactic-face-function (state) + (when (and (null (nth 3 state)) + (eq (char-after (nth 8 state)) ?#) + (eq (char-after (1+ (nth 8 state))) ?\;)) + ;; It's a sexp-comment. Tell parse-partial-sexp where it ends. + (save-excursion + (let ((pos (point)) + (end + (condition-case err + (let ((parse-sexp-lookup-properties nil)) + (goto-char (+ 2 (nth 8 state))) + ;; FIXME: this doesn't handle the case where the sexp + ;; itself contains a #; comment. + (forward-sexp 1) + (point)) + (scan-error (nth 2 err))))) + (when (< pos (- end 2)) + (put-text-property pos (- end 2) + 'syntax-table scheme-sexp-comment-syntax-table)) + (put-text-property (- end 1) end 'syntax-table '(12))))) + ;; Choose the face to use. + (lisp-font-lock-syntactic-face-function state)) + ;;;###autoload -(defun dsssl-mode () +(define-derived-mode dsssl-mode scheme-mode "DSSSL" "Major mode for editing DSSSL code. Editing commands are similar to those of `lisp-mode'. @@ -357,20 +406,16 @@ Blank lines separate paragraphs. Semicolons start comments. 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 'page-delimiter) (setq page-delimiter "^;;;" ; ^L not valid SGML char major-mode 'dsssl-mode mode-name "DSSSL") ;; Insert a suitable SGML declaration into an empty buffer. + ;; FIXME: This should use `auto-insert-alist' instead. (and (zerop (buffer-size)) (stringp dsssl-sgml-declaration) (not buffer-read-only) (insert dsssl-sgml-declaration)) - (scheme-mode-variables) (setq font-lock-defaults '(dsssl-font-lock-keywords nil t (("+-*/.<>=?$%_&~^:" . "w")) beginning-of-defun @@ -378,9 +423,7 @@ that variable's value is a string." (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)) + '(("+-*/.<>=?$%_&~^:" . "w")))) ;; Extra syntax for DSSSL. This isn't separated from Scheme, but ;; shouldn't cause much trouble in scheme-mode. @@ -558,5 +601,5 @@ that variable's value is a string." (provide 'scheme) -;;; arch-tag: a8f06bc1-ad11-42d2-9e36-ce651df37a90 +;; arch-tag: a8f06bc1-ad11-42d2-9e36-ce651df37a90 ;;; scheme.el ends here