/[guile]/guile/guile-core/ice-9/regex.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/regex.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7.2.1 by mdj, Thu Oct 18 19:41:08 2001 UTC revision 1.7.2.2 by ttn, Fri Feb 8 03:20:56 2002 UTC
# Line 1  Line 1 
1  ;;;;    Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.  ;;;;    Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.
2  ;;;;  ;;;;
3  ;;;; This program is free software; you can redistribute it and/or modify  ;;;; This program is free software; you can redistribute it and/or modify
4  ;;;; it under the terms of the GNU General Public License as published by  ;;;; it under the terms of the GNU General Public License as published by
5  ;;;; the Free Software Foundation; either version 2, or (at your option)  ;;;; the Free Software Foundation; either version 2, or (at your option)
6  ;;;; any later version.  ;;;; any later version.
7  ;;;;  ;;;;
8  ;;;; This program is distributed in the hope that it will be useful,  ;;;; This program is distributed in the hope that it will be useful,
9  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of  ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11  ;;;; GNU General Public License for more details.  ;;;; GNU General Public License for more details.
12  ;;;;  ;;;;
13  ;;;; You should have received a copy of the GNU General Public License  ;;;; You should have received a copy of the GNU General Public License
14  ;;;; along with this software; see the file COPYING.  If not, write to  ;;;; along with this software; see the file COPYING.  If not, write to
15  ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,  ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
# Line 38  Line 38 
38  ;;;; If you write modifications of your own for GUILE, it is your choice  ;;;; If you write modifications of your own for GUILE, it is your choice
39  ;;;; whether to permit this exception to apply to your modifications.  ;;;; whether to permit this exception to apply to your modifications.
40  ;;;; If you do not wish that, delete this exception notice.  ;;;; If you do not wish that, delete this exception notice.
41  ;;;;  ;;;;
42    
43    ;;; Commentary:
44    
45    ;; These procedures are exported:
46    ;;  (match:count match)
47    ;;  (match:string match)
48    ;;  (match:prefix match)
49    ;;  (match:suffix match)
50    ;;  (regexp-match? match)
51    ;;  (regexp-quote string)
52    ;;  (match:start match . submatch-num)
53    ;;  (match:end match . submatch-num)
54    ;;  (match:substring match . submatch-num)
55    ;;  (string-match pattern str . start)
56    ;;  (regexp-substitute port match . items)
57    ;;  (fold-matches regexp string init proc . flags)
58    ;;  (list-matches regexp string . flags)
59    ;;  (regexp-substitute/global port regexp string . items)
60    
61    ;;; Code:
62    
63  ;;;; POSIX regex support functions.  ;;;; POSIX regex support functions.
64    
# Line 83  Line 103 
103                  (loop (+ 1 i)))                  (loop (+ 1 i)))
104                 (else #f)))))                 (else #f)))))
105    
106  (define (regexp-quote regexp)  (define (regexp-quote string)
107    (call-with-output-string    (call-with-output-string
108     (lambda (p)     (lambda (p)
109       (let loop ((i 0))       (let loop ((i 0))
110         (and (< i (string-length regexp))         (and (< i (string-length string))
111              (begin              (begin
112                (case (string-ref regexp i)                (case (string-ref string i)
113                  ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\})                  ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\})
114                   (write-char #\\ p)))                   (write-char #\\ p)))
115                (write-char (string-ref regexp i) p)                (write-char (string-ref string i) p)
116                (loop (1+ i))))))))                (loop (1+ i))))))))
117    
118  (define (match:start match . args)  (define (match:start match . args)
# Line 197  Line 217 
217                ;; for-each, because we need to make sure 'post at the                ;; for-each, because we need to make sure 'post at the
218                ;; end of the item list is a tail call.                ;; end of the item list is a tail call.
219                (let next-item ((items items))                (let next-item ((items items))
220              
221                  (define (do-item item)                  (define (do-item item)
222                    (cond                    (cond
223                     ((string? item)    (display item port))                     ((string? item)    (display item port))
224                     ((integer? item)   (display (match:substring m item) port))                     ((integer? item)   (display (match:substring m item) port))
225                     ((procedure? item) (display (item m) port))                     ((procedure? item) (display (item m) port))
226                     ((eq? item 'pre)                       ((eq? item 'pre)
227                      (display                      (display
228                       (substring string start (match:start m))                       (substring string start (match:start m))
229                       port))                       port))

Legend:
Removed from v.1.7.2.1  
changed lines
  Added in v.1.7.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26