From 2be33da3ef31863398f10ee39b5754b2b3abe8ea Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 24 Apr 1996 02:05:35 +0000 Subject: [PATCH] Generalize lisp indentation code to support a new method for specifying how a lisp form is to be indented. The variable lisp-indent-regexps is an alist of regexp-method pairs, which is searched linearly for the first regexp that matches the keyword. This allows the "def" and "with-" rules to be implemented as special cases of this more general mechanism. --- v7/src/edwin/edwin.pkg | 3 +- v7/src/edwin/linden.scm | 93 ++++++++++++-------- v7/src/edwin/schmod.scm | 183 +++++++++++++++++++--------------------- 3 files changed, 148 insertions(+), 131 deletions(-) diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg index 84da89530..f92690a2d 100644 --- a/v7/src/edwin/edwin.pkg +++ b/v7/src/edwin/edwin.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: edwin.pkg,v 1.190 1996/04/24 01:57:40 cph Exp $ +$Id: edwin.pkg,v 1.191 1996/04/24 02:04:58 cph Exp $ Copyright (c) 1989-96 Massachusetts Institute of Technology @@ -581,6 +581,7 @@ MIT in each case. |# edwin-variable$lisp-indent-hook edwin-variable$lisp-indent-methods edwin-variable$lisp-indent-offset + edwin-variable$lisp-indent-regexps indent-code-rigidly lisp-comment-indentation lisp-comment-locate diff --git a/v7/src/edwin/linden.scm b/v7/src/edwin/linden.scm index f82a2bf04..e79c512d5 100644 --- a/v7/src/edwin/linden.scm +++ b/v7/src/edwin/linden.scm @@ -1,6 +1,6 @@ ;;; -*-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 ;;; @@ -48,18 +48,37 @@ (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 @@ -99,8 +118,10 @@ (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)) @@ -130,15 +151,15 @@ ;; 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))))))) ;;;; Indent Hook @@ -156,41 +177,40 @@ (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 @@ -201,7 +221,8 @@ (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 @@ -211,14 +232,14 @@ (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))))))) ;;;; Indent Line diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm index ebd4f8238..a256ae26d 100644 --- a/v7/src/edwin/schmod.scm +++ b/v7/src/edwin/schmod.scm @@ -1,8 +1,8 @@ ;;; -*-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 @@ -49,8 +49,7 @@ (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. @@ -65,45 +64,27 @@ The following commands evaluate Scheme expressions: \\[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 @@ -171,57 +152,58 @@ The following commands evaluate Scheme expressions: 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))) ;;;; Completion @@ -229,13 +211,13 @@ The following commands evaluate Scheme expressions: (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))) @@ -246,7 +228,7 @@ The following commands evaluate Scheme expressions: (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)))))))) @@ -303,10 +285,11 @@ are considered for completion." (lambda (all-symbols?) (scheme-complete-symbol (not all-symbols?)))) (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))) @@ -318,7 +301,19 @@ The \"current\" procedure is the expression at the head of the enclosing list." (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)))))))) -- 2.25.1