emacs/guile-scheme.el

   1 ;;; guile-scheme.el --- Guile Scheme editing mode.
   2
   3 ;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
   4
   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)
   8 ;; any later version.
   9
  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.
  14
  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.
  19
  20 ;;; Code:
  21
  22 (require 'scheme)
  23
  24 (defgroup guile-scheme nil
  25   "Editing Guile-Scheme code"
  26   :group 'lisp)
  27
  28 (defvar guile-scheme-syntax-keywords
  29   '((begin 0) (if 1) (cond 0) (case 1) (do 2) (try 1)
  30     quote syntax lambda and or else delay receive
  31     (match 1) (match-lambda 0) (match-lambda* 0)
  32     (let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
  33     (let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
  34
  35 (defvar guile-scheme-special-procedures
  36   '((catch 1) (lazy-catch 1) (stack-catch 1)
  37     map for-each (dynamic-wind 3)))
  38
  39 (dolist (x (append guile-scheme-syntax-keywords
  40                    guile-scheme-special-procedures))
  41   (when (consp x)
  42     (put (car x) 'scheme-indent-function (cadr x))))
  43
  44 ;; This is shared by cmuscheme and xscheme.
  45 (defcustom guile-scheme-program-name "guile"
  46   "*Program invoked by the `run-scheme' command."
  47   :type 'string
  48   :group 'guile-scheme)
  49
  50 (defconst guile-scheme-font-lock-keywords
  51   (eval-when-compile
  52     (list
  53      (list (concat "(\\(define\\*?\\("
  54                    ;; Function names.
  55                    "\\(\\|-public\\|-method\\|-generic\\)\\|"
  56                    ;; Macro names, as variable names.  A bit dubious, this.
  57                    "\\(-syntax\\|-macro\\)\\|"
  58                    ;; Others
  59                    "-\\sw+\\)\\)\\>"
  60                    ;; Any whitespace and declared object.
  61                    "\\s *(?\\(\\sw+\\)?")
  62            '(1 font-lock-keyword-face)
  63            '(5 (cond ((match-beginning 3) font-lock-function-name-face)
  64                      ((match-beginning 4) font-lock-variable-name-face)
  65                      (t font-lock-type-face)) nil t))
  66      (list (concat
  67             "(" (regexp-opt
  68                  (mapcar (lambda (e)
  69                            (prin1-to-string (if (consp e) (car e) e)))
  70                          (append guile-scheme-syntax-keywords
  71                                  guile-scheme-special-procedures)) 'words))
  72            '(1 font-lock-keyword-face))
  73      '("<\\sw+>" . font-lock-type-face)
  74      '("\\<:\\sw+\\>" . font-lock-builtin-face)
  75      ))
  76   "Expressions to highlight in Guile-Scheme modes.")
  77
  78 (defvar guile-scheme-mode-syntax-table nil)
  79 (unless guile-scheme-mode-syntax-table
  80   (let ((i 0))
  81     (setq guile-scheme-mode-syntax-table (make-syntax-table))
  82     (set-syntax-table guile-scheme-mode-syntax-table)
  83
  84     ;; Default is atom-constituent.
  85     (while (< i 256)
  86       (modify-syntax-entry i "_   ")
  87       (setq i (1+ i)))
  88
  89     ;; Word components.
  90     (setq i ?0)
  91     (while (<= i ?9)
  92       (modify-syntax-entry i "w   ")
  93       (setq i (1+ i)))
  94     (setq i ?A)
  95     (while (<= i ?Z)
  96       (modify-syntax-entry i "w   ")
  97       (setq i (1+ i)))
  98     (setq i ?a)
  99     (while (<= i ?z)
 100       (modify-syntax-entry i "w   ")
 101       (setq i (1+ i)))
 102
 103     ;; Whitespace
 104     (modify-syntax-entry ?\t "    ")
 105     (modify-syntax-entry ?\n ">   ")
 106     (modify-syntax-entry ?\f "    ")
 107     (modify-syntax-entry ?\r "    ")
 108     (modify-syntax-entry ?  "    ")
 109
 110     ;; These characters are delimiters but otherwise undefined.
 111     ;; Brackets and braces balance for editing convenience.
 112     (modify-syntax-entry ?\[ "(]  ")
 113     (modify-syntax-entry ?\] ")[  ")
 114     (modify-syntax-entry ?{ "(}  ")
 115     (modify-syntax-entry ?} "){  ")
 116     (modify-syntax-entry ?\| "  23")
 117
 118     ;; Other atom delimiters
 119     (modify-syntax-entry ?\( "()  ")
 120     (modify-syntax-entry ?\) ")(  ")
 121     (modify-syntax-entry ?\; "<   ")
 122     (modify-syntax-entry ?\" "\"    ")
 123     (modify-syntax-entry ?' "  p")
 124     (modify-syntax-entry ?` "  p")
 125     (modify-syntax-entry ?. "  p")
 126
 127     ;; Special characters
 128     (modify-syntax-entry ?, "_ p")
 129     (modify-syntax-entry ?# "_ p14")
 130     (modify-syntax-entry ?\\ "\\   ")))
 131
 132 (defvar guile-scheme-mode-line-process "")
 133
 134 (defvar guile-scheme-mode-map nil
 135   "Keymap for Guile Scheme mode.
 136 All commands in `lisp-mode-shared-map' are inherited by this map.")
 137
 138 (unless guile-scheme-mode-map
 139   (let ((map (make-sparse-keymap "Guile-Scheme")))
 140     (setq guile-scheme-mode-map (make-sparse-keymap))
 141     (set-keymap-parent guile-scheme-mode-map lisp-mode-shared-map)
 142     (define-key guile-scheme-mode-map [menu-bar] (make-sparse-keymap))
 143     (define-key guile-scheme-mode-map [menu-bar guile-scheme]
 144       (cons "Guile Scheme" map))
 145     (define-key map [run-guile-scheme]
 146       '("Run Inferior Guile-Scheme" . run-guile-scheme))
 147     (define-key map [uncomment-region]
 148       '("Uncomment Out Region" . (lambda (beg end)
 149                                    (interactive "r")
 150                                    (comment-region beg end '(4)))))
 151     (define-key map [comment-region] '("Comment Out Region" . comment-region))
 152     (define-key map [indent-region] '("Indent Region" . indent-region))
 153     (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
 154     (put 'comment-region 'menu-enable 'mark-active)
 155     (put 'uncomment-region 'menu-enable 'mark-active)
 156     (put 'indent-region 'menu-enable 'mark-active)))
 157
 158 (defcustom guile-scheme-mode-hook nil
 159   "Normal hook run when entering `guile-scheme-mode'.
 160 See `run-hooks'."
 161   :type 'hook
 162   :group 'guile-scheme)
 163
 164 \f
 165 ;;;
 166 ;;; Guile Scheme mode
 167 ;;;
 168
 169 ;;;###autoload
 170 (defun guile-scheme-mode ()
 171   "Major mode for editing Guile-Scheme code.
 172 Editing commands are similar to those of `lisp-mode'.
 173
 174 In addition, if an inferior Scheme process is running, some additional
 175 commands will be defined, for evaluating expressions and controlling
 176 the interpreter, and the state of the process will be displayed in the
 177 modeline of all Scheme buffers.  The names of commands that interact
 178 with the Scheme process start with \"xscheme-\" if you use the MIT
 179 Scheme-specific `xscheme' package; for more information see the
 180 documentation for `xscheme-interaction-mode'.  Use \\[run-scheme] to
 181 start an inferior Scheme using the more general `cmuscheme' package.
 182
 183 Commands:
 184 Delete converts tabs to spaces as it moves back.
 185 Blank lines separate paragraphs.  Semicolons start comments.
 186 \\{scheme-mode-map}
 187 Entry to this mode calls the value of `scheme-mode-hook'
 188 if that value is non-nil."
 189   (interactive)
 190   (kill-all-local-variables)
 191   (setq mode-name "Guile Scheme")
 192   (setq major-mode 'guile-scheme-mode)
 193   (use-local-map guile-scheme-mode-map)
 194   (guile-scheme-mode-variables)
 195   (run-hooks 'guile-scheme-mode-hook))
 196
 197 (defun guile-scheme-mode-variables ()
 198   (set-syntax-table guile-scheme-mode-syntax-table)
 199   (setq local-abbrev-table scheme-mode-abbrev-table)
 200   (make-local-variable 'paragraph-start)
 201   (setq paragraph-start (concat "$\\|" page-delimiter))
 202   (make-local-variable 'paragraph-separate)
 203   (setq paragraph-separate paragraph-start)
 204   (make-local-variable 'paragraph-ignore-fill-prefix)
 205   (setq paragraph-ignore-fill-prefix t)
 206   (make-local-variable 'fill-paragraph-function)
 207   (setq fill-paragraph-function 'lisp-fill-paragraph)
 208   ;; Adaptive fill mode gets in the way of auto-fill,
 209   ;; and should make no difference for explicit fill
 210   ;; because lisp-fill-paragraph should do the job.
 211   (make-local-variable 'adaptive-fill-mode)
 212   (setq adaptive-fill-mode nil)
 213   (make-local-variable 'normal-auto-fill-function)
 214   (setq normal-auto-fill-function 'lisp-mode-auto-fill)
 215   (make-local-variable 'indent-line-function)
 216   (setq indent-line-function 'lisp-indent-line)
 217   (make-local-variable 'parse-sexp-ignore-comments)
 218   (setq parse-sexp-ignore-comments t)
 219   (make-local-variable 'outline-regexp)
 220   (setq outline-regexp ";;; \\|(....")
 221   (make-local-variable 'comment-start)
 222   (setq comment-start ";")
 223   (make-local-variable 'comment-start-skip)
 224   ;; Look within the line for a ; following an even number of backslashes
 225   ;; after either a non-backslash or the line beginning.
 226   (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
 227   (make-local-variable 'comment-column)
 228   (setq comment-column 40)
 229   (make-local-variable 'comment-indent-function)
 230   (setq comment-indent-function 'lisp-comment-indent)
 231   (make-local-variable 'parse-sexp-ignore-comments)
 232   (setq parse-sexp-ignore-comments t)
 233   (make-local-variable 'lisp-indent-function)
 234   (set lisp-indent-function 'scheme-indent-function)
 235   (setq mode-line-process '("" guile-scheme-mode-line-process))
 236   (set (make-local-variable 'imenu-case-fold-search) t)
 237   (set (make-local-variable 'imenu-syntax-alist)
 238         '(("+-*/.<>=?!$%_&~^:" . "w")))
 239   (make-local-variable 'font-lock-defaults)
 240   (setq font-lock-defaults
 241         '((guile-scheme-font-lock-keywords)
 242           nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
 243           (font-lock-mark-block-function . mark-defun))))
 244
 245 (provide 'guile-scheme)
 246
 247 ;;; guile-scheme.el ends here