~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to lang/elisp/primitives/match.scm

  • Committer: Bazaar Package Importer
  • Author(s): Daniel Schepler
  • Date: 2006-11-09 03:11:16 UTC
  • Revision ID: james.westby@ubuntu.com-20061109031116-hu0q1jxqg12y6yeg
Tags: upstream-1.8.1+1
ImportĀ upstreamĀ versionĀ 1.8.1+1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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) %nil)))
 
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)