From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 3 Mar 1997 23:04:13 +0000 (+0000)
Subject: Add procedure to generate regular-expression "groups" from lists of
X-Git-Tag: 20090517-FFI~5247
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f41e6c2e56083dae5b9a19c904c99b3ff2ef59d7;p=mit-scheme.git

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 67530d4b8..8549998c5 100644
--- 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 84e6615f6..c24e2bd05 100644
--- 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 b51526519..556f97b2e 100644
--- 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)))