Commit | Line | Data |
---|---|---|
400d7382 JB |
1 | ;;;; Copyright (C) 1997 Free Software Foundation, Inc. |
2 | ;;;; | |
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. | |
7 | ;;;; | |
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. | |
12 | ;;;; | |
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, 675 Mass Ave, Cambridge, MA 02139, USA. | |
16 | ;;;; | |
17 | \f | |
18 | ;;;; POSIX regex support functions. | |
19 | ||
05817d9e JB |
20 | (define-module (ice-9 regex)) |
21 | ||
400d7382 JB |
22 | ;;; FIXME: |
23 | ;;; It is not clear what should happen if a `match' function | |
24 | ;;; is passed a `match number' which is out of bounds for the | |
25 | ;;; regexp match: return #f, or throw an error? These routines | |
26 | ;;; throw an out-of-range error. | |
27 | ||
28 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
29 | ;;;; These procedures are not defined in SCSH, but I found them useful. | |
30 | ||
05817d9e | 31 | (define-public (match:count match) |
400d7382 JB |
32 | (- (vector-length match) 1)) |
33 | ||
05817d9e | 34 | (define-public (match:string match) |
400d7382 JB |
35 | (vector-ref match 0)) |
36 | ||
05817d9e | 37 | (define-public (match:prefix match) |
400d7382 JB |
38 | (make-shared-substring (match:string match) |
39 | 0 | |
40 | (match:start match 0))) | |
41 | ||
05817d9e | 42 | (define-public (match:suffix match) |
400d7382 JB |
43 | (make-shared-substring (match:string match) |
44 | (match:end match 0))) | |
45 | ||
46 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
47 | ;;;; SCSH compatibility routines. | |
48 | ||
05817d9e | 49 | (define-public (regexp-match? match) |
400d7382 JB |
50 | (and (vector? match) |
51 | (string? (vector-ref match 0)) | |
52 | (let loop ((i 1)) | |
53 | (cond ((>= i (vector-length match)) #t) | |
54 | ((and (pair? (vector-ref match i)) | |
55 | (integer? (car (vector-ref match i))) | |
56 | (integer? (cdr (vector-ref match i)))) | |
57 | (loop (+ 1 i))) | |
58 | (else #f))))) | |
59 | ||
05817d9e | 60 | (define-public (regexp-quote regexp) |
400d7382 JB |
61 | (call-with-output-string |
62 | (lambda (p) | |
63 | (let loop ((i 0)) | |
64 | (and (< i (string-length regexp)) | |
65 | (begin | |
66 | (case (string-ref regexp i) | |
67 | ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\}) | |
68 | (write-char #\\ p))) | |
69 | (write-char (string-ref regexp i) p) | |
70 | (loop (1+ i)))))))) | |
71 | ||
05817d9e | 72 | (define-public (match:start match . args) |
400d7382 JB |
73 | (let* ((matchnum (if (pair? args) |
74 | (+ 1 (car args)) | |
75 | 1)) | |
76 | (start (car (vector-ref match matchnum)))) | |
77 | (if (= start -1) #f start))) | |
78 | ||
05817d9e | 79 | (define-public (match:end match . args) |
400d7382 JB |
80 | (let* ((matchnum (if (pair? args) |
81 | (+ 1 (car args)) | |
82 | 1)) | |
83 | (end (cdr (vector-ref match matchnum)))) | |
84 | (if (= end -1) #f end))) | |
85 | ||
05817d9e | 86 | (define-public (match:substring match . args) |
400d7382 JB |
87 | (let* ((matchnum (if (pair? args) |
88 | (car args) | |
89 | 0)) | |
90 | (start (match:start match matchnum)) | |
91 | (end (match:end match matchnum))) | |
92 | (and start end (make-shared-substring (match:string match) | |
93 | start | |
94 | end)))) | |
95 | ||
05817d9e | 96 | (define-public (string-match pattern str . args) |
400d7382 JB |
97 | (let ((rx (make-regexp pattern)) |
98 | (start (if (pair? args) (car args) 0))) | |
99 | (regexp-exec rx str start))) | |
100 | ||
05817d9e | 101 | (define-public (regexp-substitute port match . items) |
400d7382 JB |
102 | ;; If `port' is #f, send output to a string. |
103 | (if (not port) | |
104 | (call-with-output-string | |
105 | (lambda (p) | |
106 | (apply regexp-substitute p match items))) | |
107 | ||
108 | ;; Otherwise, process each substitution argument in `items'. | |
109 | (for-each (lambda (obj) | |
110 | (cond ((string? obj) (display obj port)) | |
111 | ((integer? obj) (display (match:substring match obj) port)) | |
112 | ((eq? 'pre obj) (display (match:prefix match) port)) | |
113 | ((eq? 'post obj) (display (match:suffix match) port)) | |
114 | (else (error 'wrong-type-arg obj)))) | |
115 | items))) | |
116 | ||
05817d9e | 117 | (define-public (regexp-substitute/global port regexp string . items) |
400d7382 JB |
118 | ;; If `port' is #f, send output to a string. |
119 | (if (not port) | |
120 | (call-with-output-string | |
121 | (lambda (p) | |
122 | (apply regexp-substitute/global p regexp string items))) | |
123 | ||
124 | ;; Otherwise, compile the regexp and match it against the | |
125 | ;; string, looping if 'post is encountered in `items'. | |
126 | (let ((rx (make-regexp regexp))) | |
127 | (let next-match ((str string)) | |
128 | (let ((match (regexp-exec rx str))) | |
129 | (if (not match) | |
130 | (display str port) | |
131 | ||
132 | ;; Process all of the items for this match. | |
133 | (for-each | |
134 | (lambda (obj) | |
135 | (cond | |
136 | ((string? obj) (display obj port)) | |
137 | ((integer? obj) (display (match:substring match obj) port)) | |
138 | ((procedure? obj) (display (obj match) port)) | |
139 | ((eq? 'pre obj) (display (match:prefix match) port)) | |
140 | ((eq? 'post obj) (next-match (match:suffix match))) | |
141 | (else (error 'wrong-type-arg obj)))) | |
142 | items))))))) | |
143 |