/[guile]/guile/guile-core/lang/elisp/primitives/match.scm
ViewVC logotype

Diff of /guile/guile-core/lang/elisp/primitives/match.scm

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

revision 1.1 by ossau, Fri Oct 26 16:42:43 2001 UTC revision 1.2 by ossau, Tue Jan 22 23:46:01 2002 UTC
# Line 0  Line 1 
1    (define-module (lang elisp primitives match)
2      #:use-module (lang elisp internals fset)
3      #:use-module (ice-9 regex)
4      #:use-module (ice-9 optargs))
5    
6    (define last-match #f)
7    
8    (fset 'string-match
9          (lambda (regexp string . start)
10    
11            (define emacs-string-match
12    
13              (if (defined? 'make-emacs-regexp)
14    
15                  ;; This is what we would do if we had an
16                  ;; Emacs-compatible regexp primitive, here called
17                  ;; `make-emacs-regexp'.
18                  (lambda (pattern str . args)
19                    (let ((rx (make-emacs-regexp pattern))
20                          (start (if (pair? args) (car args) 0)))
21                      (regexp-exec rx str start)))
22    
23                  ;; But we don't have Emacs-compatible regexps, and I
24                  ;; don't think it's worthwhile at this stage to write
25                  ;; generic regexp conversion code.  So work around the
26                  ;; discrepancies between Guile/libc and Emacs regexps by
27                  ;; substituting the regexps that actually occur in the
28                  ;; elisp code that we want to read.
29                  (lambda (pattern str . args)
30                    (let loop ((discrepancies '(("^[0-9]+\\.\\([0-9]+\\)" .
31                                                 "^[0-9]+\\.([0-9]+)"))))
32                      (or (null? discrepancies)
33                          (if (string=? pattern (caar discrepancies))
34                              (set! pattern (cdar discrepancies))
35                              (loop (cdr discrepancies)))))
36                    (apply string-match pattern str args))))
37    
38            (let ((match (apply emacs-string-match regexp string start)))
39              (set! last-match
40                    (if match
41                        (apply append!
42                               (map (lambda (n)
43                                      (list (match:start match n)
44                                            (match:end match n)))
45                                    (iota (match:count match))))
46                        #f)))
47    
48            (if last-match (car last-match) #f)))
49    
50    (fset 'match-beginning
51          (lambda (subexp)
52            (list-ref last-match (* 2 subexp))))
53    
54    (fset 'match-end
55          (lambda (subexp)
56            (list-ref last-match (+ (* 2 subexp) 1))))
57    
58    (fset 'substring substring)
59    
60    (fset 'match-data
61          (lambda* (#:optional integers reuse)
62            last-match))
63    
64    (fset 'set-match-data
65          (lambda (list)
66            (set! last-match list)))
67    
68    (fset 'store-match-data 'set-match-data)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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