Add syntax-table argument to `char->syntax-code' and related

procedures.  Move definition of `standard-syntax-table' from regexp
package to edwin top-level package.  Eliminate special initialization
of editor variable `syntax-table'.

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index a6a37cee6e4eac1ccea6fcb4597e7b5f8bbab6ac..b9f751495a205f292aa4dd1493b972d551a077a5 100644 (file)
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.202 1991/05/14 02:04:05 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.203 1991/05/17 18:36:59 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -138,7 +138,6 @@
     (reset-editor)
     (initialize-typein!)
     (initialize-typeout!)
-    (initialize-syntax-table!)
     (initialize-command-reader!)
     (initialize-processes!)
     (set! edwin-editor

diff --git a/v7/src/edwin/linden.scm b/v7/src/edwin/linden.scm
index d1498ce5c7465fd9f3bf2eca9627c651e7fa4803..e72c4162a24feb728d07217c12731dc9f2d02fbc 100644 (file)
--- a/v7/src/edwin/linden.scm
+++ b/v7/src/edwin/linden.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/linden.scm,v 1.119 1991/04/03 04:26:03 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/linden.scm,v 1.120 1991/05/17 18:37:55 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -129,7 +129,9 @@
               ;; LAST-SEXP is on subsequent line -- indent under the
               ;; first expression on that line.
               (forward-to-sexp-start (line-start last-sexp 0) last-sexp))))
-      (if (char=? #\( (char->syntax-code (mark-right-char first-sexp)))
+      (if (char=? #\(
+                 (char->syntax-code syntax-table
+                                    (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))
@@ -153,7 +155,8 @@
   (let ((first-sexp
         (forward-to-sexp-start (mark1+ (parse-state-containing-sexp state))
                                indent-point)))
-    (and (let ((syntax (char->syntax-code (mark-right-char first-sexp))))
+    (and (let ((syntax
+               (char->syntax-code syntax-table (mark-right-char first-sexp))))
           (or (char=? #\w syntax)
               (char=? #\_ syntax)))
         (let ((name (extract-string first-sexp

diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index f1f2d1cdba7dc5dfd9622d5eb98fe36543394a31..f37b9178ed0a55d0972f0006bdde9c2ad5a1d47d 100644 (file)
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.143 1991/05/17 04:51:03 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.144 1991/05/17 18:38:11 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -529,10 +529,8 @@ a repetition of this command will exit."
             (let ((index
                    (and (string-prefix-ci? string new-string)
                         (substring-find-next-char-not-of-syntax
-                         new-string
-                         (string-length string)
-                         end
-                         #\w))))
+                         new-string (string-length string) end
+                         (ref-variable syntax-table) #\w))))
               (if index
                   (substring new-string 0 (1+ index))
                   new-string))))))

diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 709185721d19d84d0d1d6904a768f0896a06c7e1..8371a331714a9f5228290e28221a6fc5e4d38bbd 100644 (file)
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.57 1991/05/10 22:15:58 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/regexp.scm,v 1.58 1991/05/17 18:38:32 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -48,7 +48,6 @@
 \f
 (define registers (make-vector 20))
 (define match-group (object-hash false))
-(define standard-syntax-table (make-syntax-table))
 
 (define-integrable (re-match-start-index i)
   (vector-ref registers i))

diff --git a/v7/src/edwin/sercom.scm b/v7/src/edwin/sercom.scm
index a1bdd1dde220711e9adc8b49a77dd8435e4f223f..02b1d6e61752fce17d8931b26d617734e5f02d35 100644 (file)
--- a/v7/src/edwin/sercom.scm
+++ b/v7/src/edwin/sercom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.58 1991/05/17 04:52:02 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.59 1991/05/17 18:39:00 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -206,33 +206,27 @@ Set point to the beginning of the occurrence found."
   (apply
    string-append
    (let ((end (string-length string)))
-     (letrec
-        ((scan-word
-          (lambda (start)
-            (let loop ((index (+ start 1)))
-              (cond ((>= index end)
-                     (cons (substring string start end) '("\\b")))
-                    ((char=? #\w
-                             (char->syntax-code (string-ref string index)))
-                     (loop (+ index 1)))
-                    (else
-                     (cons (substring string start index)
-                           (scan-punctuation (+ index 1))))))))
-         (scan-punctuation
-          (lambda (index)
-            (cond ((>= index end)
-                   '("\\b"))
-                  ((char=? #\w (char->syntax-code (string-ref string index)))
-                   (cons "\\W+" (scan-word index)))
-                  (else
-                   (scan-punctuation (+ index 1)))))))
-       (let loop ((index 0))
-        (cond ((>= index end)
-               '())
-              ((char=? #\w (char->syntax-code (string-ref string index)))
-               (cons "\\b" (scan-word index)))
-              (else
-               (loop (+ index 1)))))))))
+     (let ((index
+           (substring-find-next-char-of-syntax string 0 end
+                                               syntax-table #\w)))
+       (if index
+          (cons "\\b"
+                (let loop ((start index))
+                  (let ((index
+                         (substring-find-next-char-not-of-syntax
+                          string start end
+                          syntax-table #\w)))
+                    (if index
+                        (cons (substring string start index)
+                              (let ((index
+                                     (substring-find-next-char-of-syntax
+                                      string (+ index 1) end
+                                      syntax-table #\w)))
+                                (if index
+                                    (cons "\\W+" (loop index))
+                                    '("\\b"))))
+                        (cons (substring string start end) '("\\b"))))))
+          '())))))
 \f
 ;;;; Incremental Search
 

diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm
index 85ac0504317fbb8adf66e395eb6c5c022bcf0d84..fb84d0e0c37be2fdb0a8d69663d83c9aaa8bfb55 100644 (file)
--- a/v7/src/edwin/syntax.scm
+++ b/v7/src/edwin/syntax.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.70 1991/04/23 06:44:12 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/syntax.scm,v 1.71 1991/05/17 18:39:35 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -42,80 +42,103 @@
 ;;; of that license should have been included along with this file.
 ;;;
 
-;;;; Syntax tables for Edwin
+;;;; Syntax Tables
 
 (declare (usual-integrations))
 \f
-;;;; Syntax Tables
-
-(define-variable syntax-table
-  "The syntax-table used for word and list parsing.")
-
-(define-variable syntax-ignore-comments-backwards
-  "If true, ignore comments in backwards expression parsing.
-This can be #T for comments that end in }, as in Pascal or C.
-It should be #F for comments that end in Newline, as in Lisp;
-this is because Newline occurs often when it doesn't indicate
-a comment ending."
-  false)
-
 (define-structure (syntax-table (constructor %make-syntax-table)
                                (conc-name syntax-table/))
   (entries false read-only true))
 
-(define (guarantee-syntax-table syntax-table)
-  (if (not (syntax-table? syntax-table))
-      (error "not a syntax table" syntax-table))
-  syntax-table)
-
 (define (modify-syntax-entry! syntax-table char string)
-  (guarantee-syntax-table syntax-table)
+  (if (not (syntax-table? syntax-table))
+      (error:wrong-type-argument syntax-table
+                                "syntax table"
+                                'MODIFY-SYNTAX-ENTRY!))
   (vector-set! (syntax-table/entries syntax-table)
               (char->ascii char)
-              ((ucode-primitive string->syntax-entry) string))
-  unspecific)
+              ((ucode-primitive string->syntax-entry) string)))
 
 (define (modify-syntax-entries! syntax-table cl ch string)
-  (guarantee-syntax-table syntax-table)
+  (if (not (syntax-table? syntax-table))
+      (error:wrong-type-argument syntax-table
+                                "syntax table"
+                                'MODIFY-SYNTAX-ENTRIES!))
   (let ((entries (syntax-table/entries syntax-table))
        (ah (char->ascii ch))
        (entry ((ucode-primitive string->syntax-entry) string)))
-    (let loop ((a (char->ascii cl)))
-      (vector-set! entries a entry)
-      (if (< a ah) (loop (1+ a))))))
+    (do ((a (char->ascii cl) (+ a 1)))
+       ((>= a ah) unspecific)
+      (vector-set! entries a entry))))
 
-(define make-syntax-table
-  (let ((standard-syntax-table
+(define standard-syntax-table
+  (let ((table
         (%make-syntax-table
          (make-vector 256 ((ucode-primitive string->syntax-entry) "")))))
-    (modify-syntax-entries! standard-syntax-table #\0 #\9 "w")
-    (modify-syntax-entries! standard-syntax-table #\A #\Z "w")
-    (modify-syntax-entries! standard-syntax-table #\a #\z "w")
-    (modify-syntax-entry! standard-syntax-table #\$ "w")
-    (modify-syntax-entry! standard-syntax-table #\% "w")
-    (modify-syntax-entry! standard-syntax-table #\( "()")
-    (modify-syntax-entry! standard-syntax-table #\) ")(")
-    (modify-syntax-entry! standard-syntax-table #\[ "(]")
-    (modify-syntax-entry! standard-syntax-table #\] ")[")
-    (modify-syntax-entry! standard-syntax-table #\{ "(}")
-    (modify-syntax-entry! standard-syntax-table #\} "){")
-    (modify-syntax-entry! standard-syntax-table #\" "\"")
-    (modify-syntax-entry! standard-syntax-table #\\ "\\")
+    (modify-syntax-entries! table #\0 #\9 "w")
+    (modify-syntax-entries! table #\A #\Z "w")
+    (modify-syntax-entries! table #\a #\z "w")
+    (modify-syntax-entry! table #\$ "w")
+    (modify-syntax-entry! table #\% "w")
+    (modify-syntax-entry! table #\( "()")
+    (modify-syntax-entry! table #\) ")(")
+    (modify-syntax-entry! table #\[ "(]")
+    (modify-syntax-entry! table #\] ")[")
+    (modify-syntax-entry! table #\{ "(}")
+    (modify-syntax-entry! table #\} "){")
+    (modify-syntax-entry! table #\" "\"")
+    (modify-syntax-entry! table #\\ "\\")
     (for-each (lambda (char)
-               (modify-syntax-entry! standard-syntax-table char "_"))
+               (modify-syntax-entry! table char "_"))
              (string->list "_-+*/&|<>="))
     (for-each (lambda (char)
-               (modify-syntax-entry! standard-syntax-table char "."))
+               (modify-syntax-entry! table char "."))
              (string->list ".,;:?!#@~^'`"))
-    (lambda ()
-      (%make-syntax-table
-       (vector-copy (syntax-table/entries standard-syntax-table))))))
+    table))
 
-(define (initialize-syntax-table!)
-  (set-variable! syntax-table (make-syntax-table)))
+(define (make-syntax-table)
+  (%make-syntax-table
+   (vector-copy (syntax-table/entries standard-syntax-table))))
+
+(define (char->syntax-code syntax-table char)
+  ((ucode-primitive char->syntax-code) (syntax-table/entries syntax-table)
+                                      char))
+
+(define (substring-find-next-char-of-syntax string start end
+                                           syntax-table syntax)
+  (let loop ((index start))
+    (and (< index end)
+        (if (char=? syntax
+                    (char->syntax-code syntax-table
+                                       (string-ref string index)))
+            index
+            (loop (+ index 1))))))
+
+(define (substring-find-next-char-not-of-syntax string start end
+                                               syntax-table syntax)
+  (let loop ((index start))
+    (and (< index end)
+        (if (char=? syntax
+                    (char->syntax-code syntax-table
+                                       (string-ref string index)))
+            (loop (+ index 1))
+            index))))
 \f
 ;;;; Word Parsing
 
+(define-variable syntax-table
+  "The syntax-table used for word and list parsing."
+  (make-syntax-table))
+
+(define-variable syntax-ignore-comments-backwards
+  "If true, ignore comments in backwards expression parsing.
+This can be #T for comments that end in }, as in Pascal or C.
+It should be #F for comments that end in Newline, as in Lisp;
+this is because Newline occurs often when it doesn't indicate
+a comment ending."
+  false
+  boolean?)
+
 (define forward-word)
 (define backward-word)
 (let ()
@@ -200,9 +223,53 @@ a comment ending."
    (group-start-index (mark-group mark))))
 
 (define (mark-left-char-quoted? mark)
-  (if (not (group-start? mark))
-      (mark-right-char-quoted? (mark-1+ mark))
-      (error "Mark has no left char" mark)))
+  (if (group-start? mark)
+      (error "Mark has no left char" mark))
+  (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))
+
+(define (forward-to-sexp-start mark end)
+  (parse-state-location (parse-partial-sexp mark end 0 true)))
+
+(define (parse-partial-sexp start end
+                           #!optional target-depth stop-before? old-state)
+  (if (not (mark<= start end))
+      (error "Marks incorrectly related:" start end))
+  (let ((target-depth
+        (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))
+       (group (mark-group start)))
+    (let ((state
+          ((ucode-primitive scan-sexps-forward)
+           (syntax-table/entries (ref-variable syntax-table))
+           group
+           (mark-index start)
+           (mark-index end)
+           target-depth stop-before? old-state)))
+      ;; Convert the returned indices to marks.
+      (if (parse-state-last-sexp state)
+         (set-parse-state-last-sexp! 
+          state 
+          (make-mark group (parse-state-last-sexp state))))
+      (if (parse-state-containing-sexp state)
+         (set-parse-state-containing-sexp! 
+          state
+          (make-mark group (parse-state-containing-sexp state))))
+      (set-parse-state-location! state
+                                (make-mark group
+                                           (parse-state-location state)))
+      state)))
 \f
 (define forward-one-sexp)
 (define backward-one-sexp)
@@ -274,69 +341,6 @@ a comment ending."
 
 )
 \f
-(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))
-
-(define (forward-to-sexp-start mark end)
-  (parse-state-location (parse-partial-sexp mark end 0 true)))
-
-(define (parse-partial-sexp start end
-                           #!optional target-depth stop-before? old-state)
-  (if (not (mark<= start end))
-      (error "Marks incorrectly related" start end))
-  (let ((target-depth
-        (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))
-       (group (mark-group start)))
-    (let ((state
-          ((ucode-primitive scan-sexps-forward)
-           (syntax-table/entries (ref-variable syntax-table))
-           group
-           (mark-index start)
-           (mark-index end)
-           target-depth stop-before? old-state)))
-      ;; Convert the returned indices to marks.
-      (if (parse-state-last-sexp state)
-         (set-parse-state-last-sexp! 
-          state 
-          (make-mark group (parse-state-last-sexp state))))
-      (if (parse-state-containing-sexp state)
-         (set-parse-state-containing-sexp! 
-          state
-          (make-mark group (parse-state-containing-sexp state))))
-      (set-parse-state-location! state
-                                (make-mark group
-                                           (parse-state-location state)))
-      state)))
-
-(define (char->syntax-code char)
-  ((ucode-primitive char->syntax-code)
-   (syntax-table/entries (ref-variable syntax-table))
-   char))
-
-(define (substring-find-next-char-of-syntax string start end syntax)
-  (let loop ((index start))
-    (and (not (= index end))
-        (if (char=? syntax (char->syntax-code (string-ref string index)))
-            index
-            (loop (1+ index))))))
-
-(define (substring-find-next-char-not-of-syntax string start end syntax)
-  (let loop ((index start))
-    (and (not (= index end))
-        (if (char=? syntax (char->syntax-code (string-ref string index)))
-            (loop (1+ index))
-            index))))
-\f
 ;;;; Definition Start/End
 
 (define-variable definition-start