Changeset 20703 in project


Ignore:
Timestamp:
10/07/10 22:20:53 (11 years ago)
Author:
sjamaan
Message:

Update fancypants to strictly use irregex and tag 0.4

Location:
release/4/fancypants
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/fancypants/tags/0.4/fancypants.scm

    r20034 r20703  
    11;;; fancypants - Automatic ASCII smart quotes and ligature handling for SXML
    22;
    3 ; Copyright (c) 2006-2009 Peter Bex (Peter.Bex@xs4all.nl)
     3; Copyright (c) 2006-2010 Peter Bex (Peter.Bex@xs4all.nl)
    44; All rights reserved.
    55;
     
    3636(import chicken scheme)
    3737
    38 (use data-structures srfi-1 srfi-13 regex)
    39 (import irregex)
     38(use data-structures srfi-1 srfi-13)
     39(cond-expand
     40 (total-irregex
     41  (require-library irregex)
     42  (import irregex))
     43 (else
     44  (require-library regex)
     45  (import (rename irregex
     46                  (irregex-match-start irregex-match-start-index)
     47                  (irregex-match-end irregex-match-end-index)))
     48  (define (irregex-match-valid-index? m i)
     49    (and (irregex-match-start-index m i) #t))))
    4050
    4151;; Split up a string at predefined points, returning a list with the pieces.
     
    149159        (let string-loop ((str (car contents))
    150160                          (result-strings '()))
    151           (let ((pos (string-search-positions big-regex str)))
    152             (if (not pos)
     161          (let ((match (irregex-search big-regex str)))
     162            (if (not match)
    153163                (let ((string-list (append result-strings (list str))))
    154164                  (if (null? string-list)
    155165                      (loop (cdr contents) result)
    156166                      (loop (cdr contents) (cons (cons '*flatten* string-list) result))))
    157                 (let* ((before (string-take str (caar pos))) ; non-matching part
    158                        (after  (string-drop str (cadar pos))) ; non-matching part
    159                        (match-pos  (list-index (lambda (x) (car x)) (cdr pos)))
     167                (let* ((before (string-take str (irregex-match-start-index match 0))) ; non-matching part
     168                       (after  (string-drop str (irregex-match-end-index match 0))) ; non-matching part
     169                       (match-pos (let lp ((pos 1))
     170                                    (if (irregex-match-valid-index? match pos)
     171                                        pos
     172                                        (lp (add1 pos)))))
    160173                        ;; Three parts of the matching quotes
    161174                       (parts (car (drop quotes (quotient match-pos 3))))
    162                        ;; Matching positions (corresponding to parts)
    163                        (matching (drop (cdr pos) match-pos))
    164                        (pre  (string-copy str (car (first matching)) (cadr (first matching))))
    165                        (post (string-copy str (car (third matching)) (cadr (third matching))))
     175                       (pre  (irregex-match-substring match match-pos))
     176                       (post (irregex-match-substring match (+ match-pos 2)))
    166177                       (new-quote
    167178                        (case (fourth parts)
  • release/4/fancypants/tags/0.4/fancypants.setup

    r20034 r20703  
    11;; -*- scheme -*-
    2 (run (csc -s -O2 -d0 fancypants.scm -j fancypants))
     2
     3(define regex-version
     4  (if (version>=? (chicken-version) "4.6.2")
     5      'total-irregex
     6      'irregex-through-regex))
     7
     8(run (csc -s -O2 -d0 -D ,regex-version fancypants.scm -j fancypants))
    39(run (csc -s -O2 -d0 fancypants.import.scm))
    410
     
    612 'fancypants
    713 '("fancypants.so" "fancypants.import.so")
    8  '((version "0.3")
     14 '((version "0.4")
    915   (documentation "fancypants.html")))
  • release/4/fancypants/tags/0.4/tests/run.scm

    r15547 r20703  
    11(require-extension test sxml-transforms)
    22
    3 (load "../fancypants.scm")
    4 (import fancypants)
     3(use fancypants)
    54
    65(test-group "fancification"
  • release/4/fancypants/trunk/fancypants.scm

    r20034 r20703  
    11;;; fancypants - Automatic ASCII smart quotes and ligature handling for SXML
    22;
    3 ; Copyright (c) 2006-2009 Peter Bex (Peter.Bex@xs4all.nl)
     3; Copyright (c) 2006-2010 Peter Bex (Peter.Bex@xs4all.nl)
    44; All rights reserved.
    55;
     
    3636(import chicken scheme)
    3737
    38 (use data-structures srfi-1 srfi-13 regex)
    39 (import irregex)
     38(use data-structures srfi-1 srfi-13)
     39(cond-expand
     40 (total-irregex
     41  (require-library irregex)
     42  (import irregex))
     43 (else
     44  (require-library regex)
     45  (import (rename irregex
     46                  (irregex-match-start irregex-match-start-index)
     47                  (irregex-match-end irregex-match-end-index)))
     48  (define (irregex-match-valid-index? m i)
     49    (and (irregex-match-start-index m i) #t))))
    4050
    4151;; Split up a string at predefined points, returning a list with the pieces.
     
    149159        (let string-loop ((str (car contents))
    150160                          (result-strings '()))
    151           (let ((pos (string-search-positions big-regex str)))
    152             (if (not pos)
     161          (let ((match (irregex-search big-regex str)))
     162            (if (not match)
    153163                (let ((string-list (append result-strings (list str))))
    154164                  (if (null? string-list)
    155165                      (loop (cdr contents) result)
    156166                      (loop (cdr contents) (cons (cons '*flatten* string-list) result))))
    157                 (let* ((before (string-take str (caar pos))) ; non-matching part
    158                        (after  (string-drop str (cadar pos))) ; non-matching part
    159                        (match-pos  (list-index (lambda (x) (car x)) (cdr pos)))
     167                (let* ((before (string-take str (irregex-match-start-index match 0))) ; non-matching part
     168                       (after  (string-drop str (irregex-match-end-index match 0))) ; non-matching part
     169                       (match-pos (let lp ((pos 1))
     170                                    (if (irregex-match-valid-index? match pos)
     171                                        pos
     172                                        (lp (add1 pos)))))
    160173                        ;; Three parts of the matching quotes
    161174                       (parts (car (drop quotes (quotient match-pos 3))))
    162                        ;; Matching positions (corresponding to parts)
    163                        (matching (drop (cdr pos) match-pos))
    164                        (pre  (string-copy str (car (first matching)) (cadr (first matching))))
    165                        (post (string-copy str (car (third matching)) (cadr (third matching))))
     175                       (pre  (irregex-match-substring match match-pos))
     176                       (post (irregex-match-substring match (+ match-pos 2)))
    166177                       (new-quote
    167178                        (case (fourth parts)
  • release/4/fancypants/trunk/fancypants.setup

    r20034 r20703  
    11;; -*- scheme -*-
    2 (run (csc -s -O2 -d0 fancypants.scm -j fancypants))
     2
     3(define regex-version
     4  (if (version>=? (chicken-version) "4.6.2")
     5      'total-irregex
     6      'irregex-through-regex))
     7
     8(run (csc -s -O2 -d0 -D ,regex-version fancypants.scm -j fancypants))
    39(run (csc -s -O2 -d0 fancypants.import.scm))
    410
     
    612 'fancypants
    713 '("fancypants.so" "fancypants.import.so")
    8  '((version "0.3")
     14 '((version "0.4")
    915   (documentation "fancypants.html")))
  • release/4/fancypants/trunk/tests/run.scm

    r15547 r20703  
    11(require-extension test sxml-transforms)
    22
    3 (load "../fancypants.scm")
    4 (import fancypants)
     3(use fancypants)
    54
    65(test-group "fancification"
Note: See TracChangeset for help on using the changeset viewer.