Add procedure to generate regular-expression "groups" from lists of

alternatives.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 67530d4b856faaf4667468e053eabac78fada721..8549998c5d7ea9ffb3e6f84cc66fc390bdfecab4 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.204 1997/02/23 06:24:34 cph Exp $
+$Id: edwin.pkg,v 1.205 1997/03/03 23:03:05 cph Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -562,6 +562,7 @@ MIT in each case. |#
          re-substring-match
          re-substring-search
          re-substitute-registers
+         regexp-group
          replace-match
          search-backward
          search-forward

diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 84e6615f6af75b5598110a2ffd786ad2d87f2fb0..c24e2bd0516c5e41e101446efed81ac55ae92635 100644 (file)
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: regexp.scm,v 1.67 1996/04/24 01:20:21 cph Exp $
+;;;    $Id: regexp.scm,v 1.68 1997/03/03 23:04:13 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -365,4 +365,17 @@
     (re-search-substring-forward (re-compile-pattern regexp case-fold)
                                 case-fold
                                 syntax-table
-                                string start end)))
\ No newline at end of file
+                                string start end)))
+
+(define (regexp-group alternatives)
+  (let ((alternatives
+        (list-transform-positive alternatives identity-procedure)))
+    (if (null? alternatives)
+       "\\(\\)"
+       (apply string-append
+              (cons "\\("
+                    (let loop ((alternatives alternatives))
+                      (cons (car alternatives)
+                            (if (null? (cdr alternatives))
+                                (list "\\)")
+                                (cons "\\|" (loop (cdr alternatives)))))))))))
\ No newline at end of file

diff --git a/v7/src/edwin/syntax.scm b/v7/src/edwin/syntax.scm
index b515265191abf4c955b616ba34f74abe497fdd4b..556f97b2e8d5208c4dcc0df98f5d87e245e8c6ad 100644 (file)
--- a/v7/src/edwin/syntax.scm
+++ b/v7/src/edwin/syntax.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: syntax.scm,v 1.78 1996/04/23 23:25:03 cph Exp $
+;;;    $Id: syntax.scm,v 1.79 1997/03/03 23:03:00 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -381,6 +381,12 @@ a comment ending."
 (define (parse-state-in-comment? state)
   (memv (parse-state-comment-state state) '(1 3 5 7)))
 
+(define (in-char-syntax-structure? state)
+  (or (parse-state-in-comment? state)
+      (parse-state-in-string? state)
+      (parse-state-quoted? state)
+      (not (= (parse-state-depth state) 0))))
+
 (define (forward-to-sexp-start mark end)
   (parse-state-location (parse-partial-sexp mark end 0 #t)))