From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 5 Feb 2001 18:14:54 +0000 (+0000)
Subject: New procedure RE-MATCH-EXTRACT-STRING.
X-Git-Tag: 20090517-FFI~2988
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=022bc59eda200a0570bedba1b41b4d30971c3517;p=mit-scheme.git

New procedure RE-MATCH-EXTRACT-STRING.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index dd0da0700..44ac7efd3 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.266 2001/02/05 17:45:42 cph Exp $
+$Id: edwin.pkg,v 1.267 2001/02/05 18:14:54 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -529,6 +529,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  re-match-buffer-forward
 	  re-match-data
 	  re-match-end
+	  re-match-extract-string
 	  re-match-forward
 	  re-match-start
 	  re-search-backward
diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm
index 65af6eb6f..861430b3c 100644
--- a/v7/src/edwin/regexp.scm
+++ b/v7/src/edwin/regexp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: regexp.scm,v 1.73 1999/06/26 02:02:50 cph Exp $
+;;; $Id: regexp.scm,v 1.74 2001/02/05 18:14:48 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -35,6 +35,12 @@
     (and index
 	 (make-mark (re-match-group) index))))
 
+(define (re-match-extract-string i)
+  (group-extract-string (re-match-group)
+			(or (re-match-start-index i)
+			    (error "No such register:" i))
+			(re-match-end-index i)))
+
 (define (re-match-group)
   (let ((group (object-unhash match-group)))
     (if (not group)