;;; -*-Scheme-*-
;;;
-;;; $Id: linden.scm,v 1.124 1996/04/23 22:36:38 cph Exp $
+;;; $Id: linden.scm,v 1.125 1996/04/24 02:04:49 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
;;;
\f
(define-variable lisp-indent-offset
"If not false, the number of extra columns to indent a subform."
- false)
+ #f
+ (lambda (object) (or (not object) (exact-integer? object))))
(define-variable lisp-indent-hook
"If not false, a procedure for modifying lisp indentation."
- false)
+ #f
+ (lambda (object) (or (not object) (procedure? object))))
(define-variable lisp-indent-methods
- "String table identifying special forms for lisp indentation.")
+ "String table identifying special forms for lisp indentation."
+ #f
+ (lambda (object) (or (not object) (string-table? object))))
+
+(define-variable lisp-indent-regexps
+ "Association list specifying (REGEXP . METHOD) indentation pairs.
+The first element of the list is a symbol.
+The remaining elements of the list are the indentation pairs.
+Each REGEXP is matched against the keyword of the form being indented.
+If a match is found, the METHOD associated with the first matching REGEXP
+is used to calculate the indentation for that form."
+ '(LISP-INDENT-REGEXPS)
+ (lambda (object)
+ (and (pair? object)
+ (symbol? (car object))
+ (alist? (cdr object))
+ (for-all? (cdr object) (lambda (entry) (string? (car entry)))))))
(define-variable lisp-body-indent
"Number of extra columns to indent the body of a special form."
- 2)
+ 2
+ exact-nonnegative-integer?)
;;; CALCULATE-LISP-INDENTATION returns either an integer, which is the
;;; column to indent to, or a pair. In the latter case this means
(define (simple-indent state container last-sexp indent-point)
(cond ((parse-state-in-string? state)
(mark-column (horizontal-space-end indent-point)))
- ((and (integer? (ref-variable lisp-indent-offset)) container)
- (+ (ref-variable lisp-indent-offset) (mark-column container)))
+ ((and (integer? (ref-variable lisp-indent-offset indent-point))
+ container)
+ (+ (ref-variable lisp-indent-offset indent-point)
+ (mark-column container)))
((positive? (parse-state-depth state))
(if (not last-sexp)
(mark-column (mark1+ container))
;; first expression on that line.
(forward-to-sexp-start (line-start last-sexp 0) last-sexp))))
(if (char=? #\(
- (char->syntax-code (ref-variable syntax-table)
+ (char->syntax-code (ref-variable syntax-table indent-point)
(mark-right-char first-sexp)))
;; The first expression is a list -- don't bother to call
;; the indent hook.
(mark-column (backward-prefix-chars normal-indent))
(let ((normal-indent (backward-prefix-chars normal-indent)))
- (or (and (ref-variable lisp-indent-hook)
- ((ref-variable lisp-indent-hook)
- state indent-point normal-indent))
+ (or (let ((hook (ref-variable lisp-indent-hook indent-point)))
+ (and hook
+ (hook state indent-point normal-indent)))
(mark-column normal-indent)))))))
\f
;;;; Indent Hook
(forward-to-sexp-start (mark1+ (parse-state-containing-sexp state))
indent-point)))
(and (let ((syntax
- (char->syntax-code (ref-variable syntax-table)
+ (char->syntax-code (ref-variable syntax-table indent-point)
(mark-right-char first-sexp))))
(or (char=? #\w syntax)
(char=? #\_ syntax)))
- (let ((name (extract-string first-sexp
- (forward-one-sexp first-sexp))))
- (let ((method
- (string-table-get (ref-variable lisp-indent-methods)
- name)))
- (cond ((or (eq? method 'DEFINITION)
- (and (not method)
- (<= 3 (string-length name))
- (substring-ci=? "DEF" 0 3 name 0 3)))
+ (let ((end (forward-one-sexp first-sexp)))
+ (let ((method (find-indent-method first-sexp end)))
+ (cond ((eq? method 'DEFINITION)
(lisp-indent-definition state indent-point normal-indent))
- ((and (not method)
- (<= 5 (string-length name))
- (substring-ci=? "WITH-" 0 5 name 0 5))
- (lisp-indent-special-form 1 state indent-point
- normal-indent))
- ((integer? method)
+ ((exact-integer? method)
(lisp-indent-special-form method state indent-point
normal-indent))
- (method
+ ((procedure? method)
(method state indent-point normal-indent))
- (else
- false)))))))
+ (else #f)))))))
+
+(define (find-indent-method start end)
+ (or (let ((methods (ref-variable lisp-indent-methods start)))
+ (and methods
+ (string-table-get methods (extract-string start end))))
+ (let loop ((alist (cdr (ref-variable lisp-indent-regexps start))))
+ (and (not (null? alist))
+ (if (re-match-forward (caar alist) start end #t)
+ (cdar alist)
+ (loop (cdr alist)))))))
;;; Indent the first subform in a definition at the body indent.
;;; Indent subsequent subforms normally.
(define (lisp-indent-definition state indent-point normal-indent)
- indent-point normal-indent ;ignore
+ normal-indent ;ignore
(let ((container (parse-state-containing-sexp state)))
(and (mark> (line-end container 0) (parse-state-last-sexp state))
- (+ (ref-variable lisp-body-indent) (mark-column container)))))
+ (+ (ref-variable lisp-body-indent indent-point)
+ (mark-column container)))))
;;; Indent the first N subforms normally, but then indent the
;;; remaining forms at the body-indent. If this is one of the first
(if (negative? n) (error "Special form indent hook negative" n))
(let ((container (parse-state-containing-sexp state)))
(let ((body-indent
- (+ (mark-column container) (ref-variable lisp-body-indent)))
+ (+ (mark-column container)
+ (ref-variable lisp-body-indent indent-point)))
(normal-indent (mark-column normal-indent)))
(let loop ((count n) (mark (mark1+ container)))
(let ((mark
(cond ((and mark (mark< mark indent-point))
(loop (-1+ count) mark))
((positive? count)
- (cons (+ body-indent (ref-variable lisp-body-indent))
+ (cons (+ body-indent
+ (ref-variable lisp-body-indent indent-point))
(mark-permanent! container)))
((and (zero? count)
(or (zero? n)
(<= body-indent normal-indent)))
body-indent)
- (else
- normal-indent)))))))
+ (else normal-indent)))))))
\f
;;;; Indent Line
;;; -*-Scheme-*-
;;;
-;;; $Id: schmod.scm,v 1.37 1994/10/12 00:30:25 cph Exp $
+;;; $Id: schmod.scm,v 1.38 1996/04/24 02:05:35 cph Exp $
;;;
-;;; Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology
+;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
(define-command scheme-mode
"Enter Scheme mode."
()
- (lambda ()
- (set-current-major-mode! (ref-mode-object scheme))))
+ (lambda () (set-current-major-mode! (ref-mode-object scheme))))
(define-major-mode scheme fundamental "Scheme"
"Major mode specialized for editing Scheme code.
\\[eval-current-buffer] evaluates the buffer.
\\[eval-region] evaluates the current region."
(lambda (buffer)
- (define-variable-local-value! buffer (ref-variable-object syntax-table)
- scheme-mode:syntax-table)
- (define-variable-local-value! buffer
- (ref-variable-object syntax-ignore-comments-backwards)
- false)
- (define-variable-local-value! buffer (ref-variable-object lisp-indent-hook)
- standard-lisp-indent-hook)
- (define-variable-local-value! buffer
- (ref-variable-object lisp-indent-methods)
- scheme-mode:indent-methods)
- (define-variable-local-value! buffer (ref-variable-object comment-column)
- 40)
- (define-variable-local-value! buffer
- (ref-variable-object comment-locator-hook)
- lisp-comment-locate)
- (define-variable-local-value! buffer
- (ref-variable-object comment-indent-hook)
- lisp-comment-indentation)
- (define-variable-local-value! buffer (ref-variable-object comment-start)
- ";")
- (define-variable-local-value! buffer (ref-variable-object comment-end)
- "")
+ (local-set-variable! syntax-table scheme-mode:syntax-table buffer)
+ (local-set-variable! syntax-ignore-comments-backwards #f buffer)
+ (local-set-variable! lisp-indent-hook standard-lisp-indent-hook buffer)
+ (local-set-variable! lisp-indent-methods scheme-mode:indent-methods buffer)
+ (local-set-variable! lisp-indent-regexps scheme-mode:indent-regexps buffer)
+ (local-set-variable! comment-column 40 buffer)
+ (local-set-variable! comment-locator-hook lisp-comment-locate buffer)
+ (local-set-variable! comment-indent-hook lisp-comment-indentation buffer)
+ (local-set-variable! comment-start ";" buffer)
+ (local-set-variable! comment-end "" buffer)
(let ((separate
(string-append "^$\\|" (ref-variable page-delimiter buffer))))
- (define-variable-local-value! buffer
- (ref-variable-object paragraph-start)
- separate)
- (define-variable-local-value! buffer
- (ref-variable-object paragraph-separate)
- separate))
- (define-variable-local-value! buffer
- (ref-variable-object paragraph-ignore-fill-prefix)
- true)
- (define-variable-local-value! buffer
- (ref-variable-object indent-line-procedure)
- (ref-command lisp-indent-line))
- (define-variable-local-value! buffer
- (ref-variable-object mode-line-process)
- '(RUN-LIGHT (": " RUN-LIGHT) ""))
+ (local-set-variable! paragraph-start separate buffer)
+ (local-set-variable! paragraph-separate separate buffer))
+ (local-set-variable! paragraph-ignore-fill-prefix #t buffer)
+ (local-set-variable! indent-line-procedure
+ (ref-command lisp-indent-line)
+ buffer)
+ (local-set-variable! mode-line-process
+ '(RUN-LIGHT (": " RUN-LIGHT) "")
+ buffer)
(event-distributor/invoke! (ref-variable scheme-mode-hook buffer) buffer)))
(define-variable scheme-mode-hook
1)
state indent-point normal-indent))
-(define scheme-mode:indent-methods (make-string-table))
+(define scheme-mode:indent-methods
+ (alist->string-table
+ (map (lambda (entry) (cons (symbol->string (car entry)) (cdr entry)))
+ `((BEGIN . 0)
+ (CASE . 1)
+ (DELAY . 0)
+ (DO . 2)
+ (LAMBDA . 1)
+ (LET . ,scheme-mode:indent-let-method)
+ (LET* . 1)
+ (LETREC . 1)
-(for-each (lambda (entry)
- (string-table-put! scheme-mode:indent-methods
- (symbol->string (car entry))
- (cdr entry)))
- `(
- (BEGIN . 0)
- (CASE . 1)
- (DELAY . 0)
- (DO . 2)
- (LAMBDA . 1)
- (LET . ,scheme-mode:indent-let-method)
- (LET* . 1)
- (LETREC . 1)
+ (CALL-WITH-INPUT-FILE . 1)
+ (WITH-INPUT-FROM-FILE . 1)
+ (CALL-WITH-OUTPUT-FILE . 1)
+ (WITH-OUTPUT-TO-FILE . 1)
- (CALL-WITH-INPUT-FILE . 1)
- (WITH-INPUT-FROM-FILE . 1)
- (CALL-WITH-OUTPUT-FILE . 1)
- (WITH-OUTPUT-TO-FILE . 1)
+ ;; Remainder are MIT Scheme specific.
- ;; Remainder are MIT Scheme specific.
+ (FLUID-LET . 1)
+ (IN-PACKAGE . 1)
+ (LET-SYNTAX . 1)
+ (LOCAL-DECLARE . 1)
+ (MACRO . 1)
+ (MAKE-ENVIRONMENT . 0)
+ (NAMED-LAMBDA . 1)
+ (USING-SYNTAX . 1)
- (FLUID-LET . 1)
- (IN-PACKAGE . 1)
- (LET-SYNTAX . 1)
- (LOCAL-DECLARE . 1)
- (MACRO . 1)
- (MAKE-ENVIRONMENT . 0)
- (NAMED-LAMBDA . 1)
- (USING-SYNTAX . 1)
+ (WITH-INPUT-FROM-PORT . 1)
+ (WITH-INPUT-FROM-STRING . 1)
+ (WITH-OUTPUT-TO-PORT . 1)
+ (WITH-OUTPUT-TO-STRING . 0)
+ (CALL-WITH-VALUES . 1)
+ (WITH-VALUES . 1)
+ (WITHIN-CONTINUATION . 1)
- (WITH-INPUT-FROM-PORT . 1)
- (WITH-INPUT-FROM-STRING . 1)
- (WITH-OUTPUT-TO-PORT . 1)
- (WITH-OUTPUT-TO-STRING . 0)
- (WITH-VALUES . 1)
- (WITHIN-CONTINUATION . 1)
+ (MAKE-CONDITION-TYPE . 3)
+ (WITH-RESTART . 4)
+ (WITH-SIMPLE-RESTART . 2)
+ (BIND-CONDITION-HANDLER . 2)
+ (LIST-TRANSFORM-POSITIVE . 1)
+ (LIST-TRANSFORM-NEGATIVE . 1)
+ (LIST-SEARCH-POSITIVE . 1)
+ (LIST-SEARCH-NEGATIVE . 1)
+ (SYNTAX-TABLE-DEFINE . 2)
+ (FOR-ALL? . 1)
+ (THERE-EXISTS? . 1)))))
- (MAKE-CONDITION-TYPE . 3)
- (WITH-RESTART . 4)
- (WITH-SIMPLE-RESTART . 2)
- (BIND-CONDITION-HANDLER . 2)
- (LIST-TRANSFORM-POSITIVE . 1)
- (LIST-TRANSFORM-NEGATIVE . 1)
- (LIST-SEARCH-POSITIVE . 1)
- (LIST-SEARCH-NEGATIVE . 1)
- (SYNTAX-TABLE-DEFINE . 2)
- (FOR-ALL? . 1)
- (THERE-EXISTS? . 1)
- ))
+(define scheme-mode:indent-regexps
+ `(SCHEME-MODE:INDENT-REGEXPS
+ ("DEF" . DEFINITION)
+ ("WITH-" . 1)))
\f
;;;; Completion
(let ((end
(let ((point (current-point)))
(or (re-match-forward "\\(\\sw\\|\\s_\\)+"
- point (group-end point) false)
+ point (group-end point) #f)
(let ((start (group-start point)))
(if (not (and (mark< start point)
(re-match-forward "\\sw\\|\\s_"
(mark-1+ point)
point
- false)))
+ #f)))
(editor-error "No symbol preceding point"))
point)))))
(let ((start (forward-prefix-chars (backward-sexp end 1 'LIMIT) end)))
(obarray-completions (string-downcase prefix))))
(if (not bound-only?)
completions
- (let ((environment (evaluation-environment false)))
+ (let ((environment (evaluation-environment #f)))
(list-transform-positive completions
(lambda (name)
(environment-bound? environment name))))))))
(lambda (all-symbols?) (scheme-complete-symbol (not all-symbols?))))
\f
(define-command show-parameter-list
- "Show the parameter list of the \"current\" procedure.
-The \"current\" procedure is the expression at the head of the enclosing list."
- "d"
- (lambda (point)
+ "Show the parameter list of the procedure in the call surrounding point.
+With prefix argument, the parameter list is inserted at point.
+Otherwise, it is shown in the echo area."
+ "d\nP"
+ (lambda (point insert?)
(let ((start
(forward-down-list (backward-up-list point 1 'ERROR) 1 'ERROR))
(buffer (mark-buffer point)))
(evaluation-syntax-table buffer environment))
environment))))
(if (procedure? procedure)
- (message (procedure-argl procedure))
+ (let ((argl (procedure-argl procedure)))
+ (if (and insert? (or (symbol? argl) (list? argl)))
+ (let ((point (mark-left-inserting-copy point)))
+ (if (symbol? argl)
+ (begin
+ (insert-string " . " point)
+ (insert-string (symbol->string argl) point))
+ (for-each (lambda (param)
+ (insert-char #\space point)
+ (insert-string (write-to-string param)
+ point))
+ argl)))
+ (message argl)))
(editor-error "Expression does not evaluate to a procedure: "
(extract-string start end))))))))
projects / mit-scheme.git / commitdiff