~ubuntu-branches/debian/sid/emacs24/sid

« back to all changes in this revision

Viewing changes to lisp/progmodes/scheme.el

  • Committer: Package Import Robot
  • Author(s): Rob Browning
  • Date: 2014-10-25 14:37:43 UTC
  • mfrom: (13.1.3 experimental)
  • Revision ID: package-import@ubuntu.com-20141025143743-m9q5reoyyyjq3p2h
Tags: 24.4+1-4
Update emacsen-common dependency as per policy.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
;;; scheme.el --- Scheme (and DSSSL) editing mode
2
2
 
3
 
;; Copyright (C) 1986-1988, 1997-1998, 2001-2013 Free Software
 
3
;; Copyright (C) 1986-1988, 1997-1998, 2001-2014 Free Software
4
4
;; Foundation, Inc.
5
5
 
6
6
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
99
99
    (modify-syntax-entry ?\( "()  " st)
100
100
    (modify-syntax-entry ?\) ")(  " st)
101
101
    ;; It's used for single-line comments as well as for #;(...) sexp-comments.
102
 
    (modify-syntax-entry ?\; "< 2 " st)
 
102
    (modify-syntax-entry ?\; "<"    st)
103
103
    (modify-syntax-entry ?\" "\"   " st)
104
104
    (modify-syntax-entry ?' "'   " st)
105
105
    (modify-syntax-entry ?` "'   " st)
126
126
(defun scheme-mode-variables ()
127
127
  (set-syntax-table scheme-mode-syntax-table)
128
128
  (setq local-abbrev-table scheme-mode-abbrev-table)
129
 
  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
130
 
  (set (make-local-variable 'paragraph-separate) paragraph-start)
131
 
  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
132
 
  (set (make-local-variable 'fill-paragraph-function) 'lisp-fill-paragraph)
 
129
  (setq-local paragraph-start (concat "$\\|" page-delimiter))
 
130
  (setq-local paragraph-separate paragraph-start)
 
131
  (setq-local paragraph-ignore-fill-prefix t)
 
132
  (setq-local fill-paragraph-function 'lisp-fill-paragraph)
133
133
  ;; Adaptive fill mode gets in the way of auto-fill,
134
134
  ;; and should make no difference for explicit fill
135
135
  ;; because lisp-fill-paragraph should do the job.
136
 
  (set (make-local-variable 'adaptive-fill-mode) nil)
137
 
  (set (make-local-variable 'indent-line-function) 'lisp-indent-line)
138
 
  (set (make-local-variable 'parse-sexp-ignore-comments) t)
139
 
  (set (make-local-variable 'outline-regexp) ";;; \\|(....")
140
 
  (set (make-local-variable 'comment-start) ";")
141
 
  (set (make-local-variable 'comment-add) 1)
142
 
  ;; Look within the line for a ; following an even number of backslashes
143
 
  ;; after either a non-backslash or the line beginning.
144
 
  (set (make-local-variable 'comment-start-skip)
145
 
       "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
146
 
  (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
147
 
  (set (make-local-variable 'comment-column) 40)
148
 
  (set (make-local-variable 'parse-sexp-ignore-comments) t)
149
 
  (set (make-local-variable 'lisp-indent-function) 'scheme-indent-function)
 
136
  (setq-local adaptive-fill-mode nil)
 
137
  (setq-local indent-line-function 'lisp-indent-line)
 
138
  (setq-local parse-sexp-ignore-comments t)
 
139
  (setq-local outline-regexp ";;; \\|(....")
 
140
  (setq-local add-log-current-defun-function #'lisp-current-defun-name)
 
141
  (setq-local comment-start ";")
 
142
  (setq-local comment-add 1)
 
143
  (setq-local comment-start-skip ";+[ \t]*")
 
144
  (setq-local comment-use-syntax t)
 
145
  (setq-local comment-column 40)
 
146
  (setq-local parse-sexp-ignore-comments t)
 
147
  (setq-local lisp-indent-function 'scheme-indent-function)
150
148
  (setq mode-line-process '("" scheme-mode-line-process))
151
 
  (set (make-local-variable 'imenu-case-fold-search) t)
152
 
  (setq imenu-generic-expression scheme-imenu-generic-expression)
153
 
  (set (make-local-variable 'imenu-syntax-alist)
154
 
        '(("+-*/.<>=?!$%_&~^:" . "w")))
155
 
  (set (make-local-variable 'font-lock-defaults)
156
 
       '((scheme-font-lock-keywords
157
 
          scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
158
 
         nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
159
 
         beginning-of-defun
160
 
         (font-lock-mark-block-function . mark-defun)
161
 
         (font-lock-syntactic-face-function
162
 
          . scheme-font-lock-syntactic-face-function)
163
 
         (parse-sexp-lookup-properties . t)
164
 
         (font-lock-extra-managed-props syntax-table)))
165
 
  (set (make-local-variable 'lisp-doc-string-elt-property)
166
 
       'scheme-doc-string-elt))
 
149
  (setq-local imenu-case-fold-search t)
 
150
  (setq-local imenu-generic-expression scheme-imenu-generic-expression)
 
151
  (setq-local imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w")))
 
152
  (setq-local syntax-propertize-function #'scheme-syntax-propertize)
 
153
  (setq font-lock-defaults
 
154
        '((scheme-font-lock-keywords
 
155
           scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
 
156
          nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
 
157
          beginning-of-defun
 
158
          (font-lock-mark-block-function . mark-defun)))
 
159
  (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
167
160
 
168
161
(defvar scheme-mode-line-process "")
169
162
 
210
203
Commands:
211
204
Delete converts tabs to spaces as it moves back.
212
205
Blank lines separate paragraphs.  Semicolons start comments.
213
 
\\{scheme-mode-map}
214
 
Entry to this mode calls the value of `scheme-mode-hook'
215
 
if that value is non-nil."
 
206
\\{scheme-mode-map}"
216
207
  (scheme-mode-variables))
217
208
 
218
209
(defgroup scheme nil
310
301
        "(" (regexp-opt
311
302
             '("begin" "call-with-current-continuation" "call/cc"
312
303
               "call-with-input-file" "call-with-output-file" "case" "cond"
313
 
               "do" "else" "for-each" "if" "lambda"
 
304
               "do" "else" "for-each" "if" "lambda" "λ"
314
305
               "let" "let*" "let-syntax" "letrec" "letrec-syntax"
 
306
               ;; R6RS library subforms.
 
307
               "export" "import"
315
308
               ;; SRFI 11 usage comes up often enough.
316
309
               "let-values" "let*-values"
317
310
               ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
330
323
      ;;
331
324
      ;; Scheme `:' and `#:' keywords as builtins.
332
325
      '("\\<#?:\\sw+\\>" . font-lock-builtin-face)
 
326
      ;; R6RS library declarations.
 
327
      '("(\\(\\<library\\>\\)\\s-*(?\\(\\sw+\\)?"
 
328
        (1 font-lock-keyword-face)
 
329
        (2 font-lock-type-face))
333
330
      )))
334
331
  "Gaudy expressions to highlight in Scheme modes.")
335
332
 
351
348
       (forward-comment (point-max))
352
349
       (if (eq (char-after) ?\() 2 0)))
353
350
 
354
 
(defun scheme-font-lock-syntactic-face-function (state)
355
 
  (when (and (null (nth 3 state))
356
 
             (eq (char-after (nth 8 state)) ?#)
357
 
             (eq (char-after (1+ (nth 8 state))) ?\;))
358
 
    ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
359
 
    (save-excursion
360
 
      (let ((pos (point))
361
 
            (end
362
 
             (condition-case err
363
 
                 (let ((parse-sexp-lookup-properties nil))
364
 
                   (goto-char (+ 2 (nth 8 state)))
365
 
                   ;; FIXME: this doesn't handle the case where the sexp
366
 
                   ;; itself contains a #; comment.
367
 
                   (forward-sexp 1)
368
 
                   (point))
369
 
               (scan-error (nth 2 err)))))
370
 
        (when (< pos (- end 2))
371
 
          (put-text-property pos (- end 2)
372
 
                             'syntax-table scheme-sexp-comment-syntax-table))
373
 
        (put-text-property (- end 1) end 'syntax-table '(12)))))
374
 
  ;; Choose the face to use.
375
 
  (lisp-font-lock-syntactic-face-function state))
 
351
(defun scheme-syntax-propertize (beg end)
 
352
  (goto-char beg)
 
353
  (scheme-syntax-propertize-sexp-comment (point) end)
 
354
  (funcall
 
355
   (syntax-propertize-rules
 
356
    ("\\(#\\);" (1 (prog1 "< cn"
 
357
                     (scheme-syntax-propertize-sexp-comment (point) end)))))
 
358
   (point) end))
 
359
 
 
360
(defun scheme-syntax-propertize-sexp-comment (_ end)
 
361
  (let ((state (syntax-ppss)))
 
362
    (when (eq 2 (nth 7 state))
 
363
      ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
 
364
      (condition-case nil
 
365
          (progn
 
366
            (goto-char (+ 2 (nth 8 state)))
 
367
            ;; FIXME: this doesn't handle the case where the sexp
 
368
            ;; itself contains a #; comment.
 
369
            (forward-sexp 1)
 
370
            (put-text-property (1- (point)) (point)
 
371
                               'syntax-table (string-to-syntax "> cn")))
 
372
        (scan-error (goto-char end))))))
376
373
 
377
374
;;;###autoload
378
375
(define-derived-mode dsssl-mode scheme-mode "DSSSL"
386
383
Entering this mode runs the hooks `scheme-mode-hook' and then
387
384
`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
388
385
that variable's value is a string."
389
 
  (set (make-local-variable 'page-delimiter) "^;;;") ; ^L not valid SGML char
 
386
  (setq-local page-delimiter "^;;;") ; ^L not valid SGML char
390
387
  ;; Insert a suitable SGML declaration into an empty buffer.
391
388
  ;; FIXME: This should use `auto-insert-alist' instead.
392
389
  (and (zerop (buffer-size))
397
394
                             nil t (("+-*/.<>=?$%_&~^:" . "w"))
398
395
                             beginning-of-defun
399
396
                             (font-lock-mark-block-function . mark-defun)))
400
 
  (set (make-local-variable 'imenu-case-fold-search) nil)
 
397
  (setq-local add-log-current-defun-function #'lisp-current-defun-name)
 
398
  (setq-local imenu-case-fold-search nil)
401
399
  (setq imenu-generic-expression dsssl-imenu-generic-expression)
402
 
  (set (make-local-variable 'imenu-syntax-alist)
403
 
       '(("+-*/.<>=?$%_&~^:" . "w"))))
 
400
  (setq-local imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w"))))
404
401
 
405
402
;; Extra syntax for DSSSL.  This isn't separated from Scheme, but
406
403
;; shouldn't cause much trouble in scheme-mode.
410
407
(put 'make 'scheme-indent-function 1)
411
408
(put 'style 'scheme-indent-function 1)
412
409
(put 'root 'scheme-indent-function 1)
 
410
(put 'λ 'scheme-indent-function 1)
413
411
 
414
412
(defvar dsssl-font-lock-keywords
415
413
  (eval-when-compile
535
533
(put 'letrec-syntax 'scheme-indent-function 1)
536
534
(put 'syntax-rules 'scheme-indent-function 1)
537
535
(put 'syntax-case 'scheme-indent-function 2) ; not r5rs
 
536
(put 'library 'scheme-indent-function 1) ; R6RS
538
537
 
539
538
(put 'call-with-input-file 'scheme-indent-function 1)
540
539
(put 'with-input-from-file 'scheme-indent-function 1)