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, |
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 |
|
|
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) |
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)) |