1 ;;;; Copyright (C) 1997 Free Software Foundation, Inc.
3 ;;;; 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
5 ;;;; the Free Software Foundation; either version 2, or (at your option)
6 ;;;; any later version.
8 ;;;; This program is distributed in the hope that it will be useful,
9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 ;;;; GNU General Public License for more details.
13 ;;;; 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
15 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
16 ;;;; Boston, MA 02111-1307 USA
19 ;;;; POSIX regex support functions.
21 (define-module (ice-9 regex))
24 ;;; It is not clear what should happen if a `match' function
25 ;;; is passed a `match number' which is out of bounds for the
26 ;;; regexp match: return #f, or throw an error? These routines
27 ;;; throw an out-of-range error.
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;;; These procedures are not defined in SCSH, but I found them useful.
32 (define-public (match:count match)
33 (- (vector-length match) 1))
35 (define-public (match:string match)
38 (define-public (match:prefix match)
39 (make-shared-substring (match:string match)
41 (match:start match 0)))
43 (define-public (match:suffix match)
44 (make-shared-substring (match:string match)
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;;;; SCSH compatibility routines.
50 (define-public (regexp-match? match)
52 (string? (vector-ref match 0))
54 (cond ((>= i (vector-length match)) #t)
55 ((and (pair? (vector-ref match i))
56 (integer? (car (vector-ref match i)))
57 (integer? (cdr (vector-ref match i))))
61 (define-public (regexp-quote regexp)
62 (call-with-output-string
65 (and (< i (string-length regexp))
67 (case (string-ref regexp i)
68 ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\})
70 (write-char (string-ref regexp i) p)
73 (define-public (match:start match . args)
74 (let* ((matchnum (if (pair? args)
77 (start (car (vector-ref match matchnum))))
78 (if (= start -1) #f start)))
80 (define-public (match:end match . args)
81 (let* ((matchnum (if (pair? args)
84 (end (cdr (vector-ref match matchnum))))
85 (if (= end -1) #f end)))
87 (define-public (match:substring match . args)
88 (let* ((matchnum (if (pair? args)
91 (start (match:start match matchnum))
92 (end (match:end match matchnum)))
93 (and start end (make-shared-substring (match:string match)
97 (define-public (string-match pattern str . args)
98 (let ((rx (make-regexp pattern))
99 (start (if (pair? args) (car args) 0)))
100 (regexp-exec rx str start)))
102 (define-public (regexp-substitute port match . items)
103 ;; If `port' is #f, send output to a string.
105 (call-with-output-string
107 (apply regexp-substitute p match items)))
109 ;; Otherwise, process each substitution argument in `items'.
110 (for-each (lambda (obj)
111 (cond ((string? obj) (display obj port))
112 ((integer? obj) (display (match:substring match obj) port))
113 ((eq? 'pre obj) (display (match:prefix match) port))
114 ((eq? 'post obj) (display (match:suffix match) port))
115 (else (error 'wrong-type-arg obj))))
118 (define-public (regexp-substitute/global port regexp string . items)
119 ;; If `port' is #f, send output to a string.
121 (call-with-output-string
123 (apply regexp-substitute/global p regexp string items)))
125 ;; Otherwise, compile the regexp and match it against the
126 ;; string, looping if 'post is encountered in `items'.
127 (let ((rx (make-regexp regexp)))
128 (let next-match ((str string))
129 (let ((match (regexp-exec rx str)))
133 ;; Process all of the items for this match.
137 ((string? obj) (display obj port))
138 ((integer? obj) (display (match:substring match obj) port))
139 ((procedure? obj) (display (obj match) port))
140 ((eq? 'pre obj) (display (match:prefix match) port))
141 ((eq? 'post obj) (next-match (match:suffix match)))
142 (else (error 'wrong-type-arg obj))))