From 4b076db93a8885f8bf2d6f5434cffac6406dac1c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 23 Apr 1996 22:37:42 +0000 Subject: [PATCH] Change character syntax interface to use new features implemented by microcode. The new interface is almost like that of Lucid Emacs. --- v7/src/edwin/cinden.scm | 6 +- v7/src/edwin/linden.scm | 22 +++---- v7/src/edwin/syntax.scm | 128 ++++++++++++++++++++++++++-------------- 3 files changed, 96 insertions(+), 60 deletions(-) diff --git a/v7/src/edwin/cinden.scm b/v7/src/edwin/cinden.scm index ec506d1ef..015bb528a 100644 --- a/v7/src/edwin/cinden.scm +++ b/v7/src/edwin/cinden.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: cinden.scm,v 1.13 1996/03/23 06:17:00 cph Exp $ +;;; $Id: cinden.scm,v 1.14 1996/04/23 22:37:42 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology ;;; @@ -331,9 +331,7 @@ This is in addition to c-continued-statement-offset." (values start* state*)) ((parse-state-in-comment? state*) (if (not (and state (parse-state-in-comment? state))) - (if (re-search-forward "/\\*[ \t]*" start start* false) - (c-mode:comment-indent (re-match-start 0)) - (error "Missing comment"))) + (c-mode:comment-indent (parse-state-comment-start state*))) (loop start* state*)) ((parse-state-in-string? state*) (loop start* state*)) diff --git a/v7/src/edwin/linden.scm b/v7/src/edwin/linden.scm index 0a7ceff1e..f82a2bf04 100644 --- a/v7/src/edwin/linden.scm +++ b/v7/src/edwin/linden.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: linden.scm,v 1.123 1995/03/30 21:51:13 cph Exp $ +;;; $Id: linden.scm,v 1.124 1996/04/23 22:36:38 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-95 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 @@ -312,17 +312,13 @@ (define (indent-expression-line start stack state) (maybe-change-indentation (compute-indentation start stack) start) - (if (eqv? 1 - (parse-state-in-comment? - (parse-partial-sexp start (line-end start 0) #f #f state))) - ;; PARSE-PARTIAL-SEXP should be changed so that it can report - ;; the index at which the comment starts. Since it has a more - ;; precise model of the syntax, it can return a more accurate - ;; answer. - (let ((comment (lisp-comment-locate start))) - (if comment - (maybe-change-column (lisp-comment-indentation (car comment) stack) - (car comment)))))) + (let ((state (parse-partial-sexp start (line-end start 0) #f #f state))) + (if (parse-state-in-comment? state) + (let ((comment-start (parse-state-comment-start state))) + (if (match-forward ";" comment-start) + (maybe-change-column (lisp-comment-indentation comment-start + stack) + comment-start)))))) (define (compute-indentation start stack) (cond ((null? stack) diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm index a12cbdfa8..ea9e18bae 100644 --- a/v7/src/edwin/syntax.scm +++ b/v7/src/edwin/syntax.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: syntax.scm,v 1.76 1992/11/13 22:43:33 cph Exp $ +;;; $Id: syntax.scm,v 1.77 1996/04/23 22:36:02 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989-92 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 @@ -48,7 +48,7 @@ (define-structure (syntax-table (constructor %make-syntax-table) (conc-name syntax-table/)) - (entries false read-only true)) + (entries false read-only #t)) (define (modify-syntax-entry! syntax-table char string) (if (not (syntax-table? syntax-table)) @@ -105,20 +105,34 @@ char)) (define (syntax-entry->string entry) - (let ((code (fix:and #xff entry))) + (let ((code (fix:and #xf entry))) (if (> code 12) "invalid" (string-append (vector-ref '#(" " "." "w" "_" "(" ")" "'" "\"" "$" "\\" "/" "<" ">") code) - (let ((match (fix:and #xff (fix:lsh -8 entry)))) + (let ((match (fix:and #xff (fix:lsh entry -4)))) (if (zero? match) " " (emacs-key-name (ascii->char match) false))) - (if (fix:= 0 (fix:and #x10000 entry)) "" "1") - (if (fix:= 0 (fix:and #x20000 entry)) "" "2") - (if (fix:= 0 (fix:and #x40000 entry)) "" "3") - (if (fix:= 0 (fix:and #x80000 entry)) "" "4") + (let ((cbits (fix:and #xFF (fix:lsh entry -12)))) + (string-append + (if (fix:= 0 (fix:and #x40 cbits)) "" "1") + (if (fix:= 0 (fix:and #x10 cbits)) "" "2") + (if (fix:= 0 (fix:and #x04 cbits)) "" "3") + (if (fix:= 0 (fix:and #x01 cbits)) "" "4") + (if (or (fix:= 0 (fix:and #x80 cbits)) + (and (fix:= code 11) + (fix:= #x80 (fix:and #xC0 cbits)))) + "" + "5") + (if (fix:= 0 (fix:and #x20 cbits)) "" "6") + (if (or (fix:= 0 (fix:and #x08 cbits)) + (and (fix:= code 12) + (fix:= #x08 (fix:and #x0C cbits)))) + "" + "7") + (if (fix:= 0 (fix:and #x02 cbits)) "" "8"))) (if (fix:= 0 (fix:and #x100000 entry)) "" "p"))))) (define (substring-find-next-char-of-syntax string start end @@ -181,7 +195,7 @@ which is selected so you can see it." (loop end)))))))))) (define (describe-syntax-entry entry) - (let ((code (fix:and #xff entry))) + (let ((code (fix:and #x0f entry))) (if (> code 12) (write-string "invalid") (begin @@ -191,25 +205,36 @@ which is selected so you can see it." (vector-ref '#("whitespace" "punctuation" "word" "symbol" "open" "close" "quote" "string" "math" "escape" "charquote" "comment" - "endcomment" "invalid") + "endcomment") code)) - (let ((match (fix:and #xff (fix:lsh -8 entry)))) + (let ((match (fix:and #xff (fix:lsh entry -4)))) (if (not (zero? match)) (begin (write-string ", matches ") (write-string (emacs-key-name (ascii->char match) false))))) - (if (not (fix:= 0 (fix:and #x10000 entry))) - (write-string - ",\n\t is the first character of a comment-start sequence")) - (if (not (fix:= 0 (fix:and #x20000 entry))) - (write-string - ",\n\t is the second character of a comment-start sequence")) - (if (not (fix:= 0 (fix:and #x40000 entry))) - (write-string - ",\n\t is the first character of a comment-end sequence")) - (if (not (fix:= 0 (fix:and #x80000 entry))) - (write-string - ",\n\t is the second character of a comment-end sequence")) + (let ((cbits (fix:and #xFF (fix:lsh entry -12))) + (decode-comment-bit + (lambda (code pos se style) + (if (not (fix:= 0 (fix:and code entry))) + (begin + (write-string ",\n\t is the ") + (write-string pos) + (write-string " character of comment-") + (write-string se) + (write-string " sequence ") + (write-string style)))))) + (decode-comment-bit #x40000 "first" "start" "B") + (decode-comment-bit #x10000 "second" "start" "B") + (decode-comment-bit #x04000 "first" "end" "B") + (decode-comment-bit #x01000 "second" "end" "B") + (if (not (and (fix:= code 11) + (fix:= #x80000 (fix:and #xC0000 entry)))) + (decode-comment-bit #x80000 "first" "start" "A")) + (decode-comment-bit #x20000 "second" "start" "A") + (if (not (and (fix:= code 12) + (fix:= #x08000 (fix:and #x0C000 entry)))) + (decode-comment-bit #x08000 "first" "end" "A")) + (decode-comment-bit #x02000 "second" "end" "A")) (if (not (fix:= 0 (fix:and #x100000 entry))) (write-string ",\n\t is a prefix character"))))) (newline)) @@ -336,16 +361,29 @@ a comment ending." (mark-right-char-quoted? (mark-1+ mark))) (define-structure (parse-state (type vector)) - (depth false read-only true) - (in-string? false read-only true) ;#F or ASCII delimiter. - (in-comment? false read-only true) ;#F or 1 or 2. - (quoted? false read-only true) - (last-sexp false) - (containing-sexp false) - (location false)) + (depth #f read-only #t) + (in-string? #f read-only #t) ;#F or ASCII delimiter. + ;; COMMENT-STATE takes the following values: + ;; #f = not in comment + ;; 1 = in comment (style A) + ;; 2 = after first char of two-char comment start (style A) + ;; 3 = after first char of two-char comment end (style A) + ;; 5 = in comment (style B) + ;; 6 = after first char of two-char comment start (style B) + ;; 7 = after first char of two-char comment end (style B) + ;; COMMENT-START is valid when COMMENT-STATE is not #f. + (comment-state #f read-only #t) + (quoted? #f read-only #t) + (last-sexp #f) + (containing-sexp #f) + (location #f) + (comment-start #f)) + +(define (parse-state-in-comment? state) + (memv (parse-state-comment-state state) '(1 3 5 7))) (define (forward-to-sexp-start mark end) - (parse-state-location (parse-partial-sexp mark end 0 true))) + (parse-state-location (parse-partial-sexp mark end 0 #t))) (define (parse-partial-sexp start end #!optional target-depth stop-before? old-state) @@ -355,8 +393,8 @@ a comment ending." (if (or (default-object? target-depth) (not target-depth)) -1000000 target-depth)) - (stop-before? (if (default-object? stop-before?) false stop-before?)) - (old-state (if (default-object? old-state) false old-state)) + (stop-before? (if (default-object? stop-before?) #f stop-before?)) + (old-state (if (default-object? old-state) #f old-state)) (group (mark-group start))) (let ((state ((ucode-primitive scan-sexps-forward) @@ -377,6 +415,10 @@ a comment ending." (set-parse-state-location! state (make-mark group (parse-state-location state))) + (if (parse-state-comment-start state) + (set-parse-state-comment-start! + state + (make-mark group (parse-state-comment-start state)))) state))) (define forward-one-sexp) @@ -399,7 +441,7 @@ a comment ending." (mark-index end) depth sexp? - true))) + #t))) (and index (make-mark group index))))) (define (%backward-list start end depth sexp?) @@ -419,37 +461,37 @@ a comment ending." (set! forward-one-sexp (named-lambda (forward-one-sexp start #!optional end) - (%forward-list start (default-end/forward start end) 0 true))) + (%forward-list start (default-end/forward start end) 0 #t))) (set! backward-one-sexp (named-lambda (backward-one-sexp start #!optional end) (let ((end (default-end/backward start end))) - (let ((mark (%backward-list start end 0 true))) + (let ((mark (%backward-list start end 0 #t))) (and mark (backward-prefix-chars mark end)))))) (set! forward-one-list (named-lambda (forward-one-list start #!optional end) - (%forward-list start (default-end/forward start end) 0 false))) + (%forward-list start (default-end/forward start end) 0 #f))) (set! backward-one-list (named-lambda (backward-one-list start #!optional end) - (%backward-list start (default-end/backward start end) 0 false))) + (%backward-list start (default-end/backward start end) 0 #f))) (set! forward-up-one-list (named-lambda (forward-up-one-list start #!optional end) - (%forward-list start (default-end/forward start end) 1 false))) + (%forward-list start (default-end/forward start end) 1 #f))) (set! backward-up-one-list (named-lambda (backward-up-one-list start #!optional end) - (%backward-list start (default-end/backward start end) 1 false))) + (%backward-list start (default-end/backward start end) 1 #f))) (set! forward-down-one-list (named-lambda (forward-down-one-list start #!optional end) - (%forward-list start (default-end/forward start end) -1 false))) + (%forward-list start (default-end/forward start end) -1 #f))) (set! backward-down-one-list (named-lambda (backward-down-one-list start #!optional end) - (%backward-list start (default-end/backward start end) -1 false))) + (%backward-list start (default-end/backward start end) -1 #f))) ) -- 2.25.1