From 9dfca463aa910170a3ead40f98a7041d94994b8a Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 17 May 1991 18:39:35 +0000
Subject: [PATCH] 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'.

---
 v7/src/edwin/editor.scm |   3 +-
 v7/src/edwin/linden.scm |   9 +-
 v7/src/edwin/prompt.scm |   8 +-
 v7/src/edwin/regexp.scm |   3 +-
 v7/src/edwin/sercom.scm |  50 ++++-----
 v7/src/edwin/syntax.scm | 236 ++++++++++++++++++++--------------------
 6 files changed, 153 insertions(+), 156 deletions(-)

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index a6a37cee6..b9f751495 100644
--- 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 d1498ce5c..e72c4162a 100644
--- 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 f1f2d1cdb..f37b9178e 100644
--- 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 709185721..8371a3317 100644
--- 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 @@
 
 (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 a1bdd1dde..02b1d6e61 100644
--- 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"))))))
+	   '())))))
 
 ;;;; Incremental Search
 
diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm
index 85ac05043..fb84d0e0c 100644
--- 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))
 
-;;;; 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))))
 
 ;;;; 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)))
 
 (define forward-one-sexp)
 (define backward-one-sexp)
@@ -274,69 +341,6 @@ a comment ending."
 
 )
 
-(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))))
-
 ;;;; Definition Start/End
 
 (define-variable definition-start
-- 
2.25.1