Changeset 13976 in project


Ignore:
Timestamp:
03/27/09 20:51:19 (11 years ago)
Author:
sjamaan
Message:

Simplify code a bit by removing a set! call, add another testcase

Location:
release/3/fancypants
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/3/fancypants/fancypants.scm

    r13974 r13976  
    133133;; See http://www.unicode.org/charts/PDF/U2000.pdf
    134134;; This is pretty ugly code.
    135 (define (smarten-quotes contents quotes exceptions)
     135(define (smarten-quotes contents #!optional (quotes all-quotes) (exceptions default-exceptions))
    136136  (let ((single-open-count 0)
    137137        (double-open-count 0)
     
    146146       ((pair? (car contents)) (loop (cdr contents) (cons (loop (car contents) '()) result)))
    147147       ((string? (car contents))
    148         (let ((string-list
    149                (let string-loop ((str (car contents))
    150                                  (result-strings '()))
    151                  (let ((pos (string-search-positions big-regex str)))
    152                    (if (not pos)
    153                        (append result-strings (list str))
    154                        (let* ((before (string-take str (caar pos))) ;; non-matching part
    155                               (after  (string-drop str (cadar pos))) ;; non-matching part
    156                               (match-pos  (list-index identity (cdr pos)))
    157                               (parts (car (drop quotes (quotient match-pos 3)))) ;; Three parts of the matching quotes
    158                               (matching (drop (cdr pos) match-pos)) ;; Matching positions (corresponding to parts)
    159                               (pre  (string-copy str (car (first matching)) (cadr (first matching))))
    160                               (post (string-copy str (car (third matching)) (cadr (third matching))))
    161                               (new-quote "")) ;; The new quote.  This gets set! to the proper value :S
    162                          (case (fourth parts)
    163                            ((single-open)
    164                             (if (fifth parts)
    165                                 (set! single-open-count (add1 single-open-count)))
    166                             (set! new-quote '(& "#x2018")))
    167                            ((single-close)
    168                             (if (and (fifth parts) (> single-open-count 0))
    169                                 (set! single-open-count (add1 single-open-count)))
    170                             (set! new-quote '(& "#x2019")))
    171                            ((double-open)
    172                             (if (fifth parts)
    173                                 (set! double-open-count (add1 double-open-count)))
    174                             (set! new-quote '(& "#x201c")))
    175                            ((double-close)
    176                             (if (and (fifth parts) (> double-open-count 0))
    177                                 (set! single-open-count (add1 double-open-count)))
    178                             (set! new-quote '(& "#x201d")))
    179                            ;; For the balanced ones, close it if it was open,
    180                            ;; open it if it was closed
    181                            ((single)
    182                             (if (> single-open-count 0)
    183                                 (begin
    184                                   (if (fifth parts) (set! single-open-count (sub1 single-open-count)))
    185                                   (set! new-quote '(& "#x2019")))
    186                                 (begin
    187                                   (if (fifth parts) (set! single-open-count (add1 single-open-count)))
    188                                   (set! new-quote '(& "#x2018")))))
    189                            ((double)
    190                             (if (> double-open-count 0)
    191                                 (begin
    192                                   (if (fifth parts) (set! double-open-count (sub1 double-open-count)))
    193                                   (set! new-quote '(& "#x201d")))
    194                                 (begin
    195                                   (if (fifth parts) (set! double-open-count (add1 double-open-count)))
    196                                   (set! new-quote '(& "#x201c")))))
    197                            (else (error 'smarten-quotes "Unkown quote matching type: " (fourth parts))))
    198                          (string-loop
    199                           after
    200                           ;; XXX don't use empty strings for before/pre and post
    201                           (append result-strings
    202                                   (list (string-append before pre) new-quote post)))))))))
    203           (if (null? string-list)
    204               (loop (cdr contents) result)
    205               (loop (cdr contents) (cons (cons '*flatten* string-list) result)))))
     148        (let string-loop ((str (car contents))
     149                          (result-strings '()))
     150          (let ((pos (string-search-positions big-regex str)))
     151            (if (not pos)
     152                (let ((string-list (append result-strings (list str))))
     153                  (if (null? string-list)
     154                      (loop (cdr contents) result)
     155                      (loop (cdr contents) (cons (cons '*flatten* string-list) result))))
     156                (let* ((before (string-take str (caar pos))) ;; non-matching part
     157                       (after  (string-drop str (cadar pos))) ;; non-matching part
     158                       (match-pos  (list-index identity (cdr pos)))
     159                       (parts (car (drop quotes (quotient match-pos 3)))) ;; Three parts of the matching quotes
     160                       (matching (drop (cdr pos) match-pos)) ;; Matching positions (corresponding to parts)
     161                       (pre  (string-copy str (car (first matching)) (cadr (first matching))))
     162                       (post (string-copy str (car (third matching)) (cadr (third matching))))
     163                       (new-quote
     164                        (case (fourth parts)
     165                          ((single-open)
     166                           (when (fifth parts)
     167                               (set! single-open-count (add1 single-open-count)))
     168                           '(& "#x2018"))
     169                          ((single-close)
     170                           (when (and (fifth parts) (> single-open-count 0))
     171                               (set! single-open-count (add1 single-open-count)))
     172                           '(& "#x2019"))
     173                          ((double-open)
     174                           (when (fifth parts)
     175                               (set! double-open-count (add1 double-open-count)))
     176                           '(& "#x201c"))
     177                          ((double-close)
     178                           (when (and (fifth parts) (> double-open-count 0))
     179                               (set! single-open-count (add1 double-open-count)))
     180                           '(& "#x201d"))
     181                          ;; For the balanced ones, close it if it was open,
     182                          ;; open it if it was closed
     183                          ((single)
     184                           (if (> single-open-count 0)
     185                               (begin
     186                                 (when (fifth parts) (set! single-open-count (sub1 single-open-count)))
     187                                 '(& "#x2019"))
     188                               (begin
     189                                 (when (fifth parts) (set! single-open-count (add1 single-open-count)))
     190                                 '(& "#x2018"))))
     191                          ((double)
     192                           (if (> double-open-count 0)
     193                               (begin
     194                                 (when (fifth parts) (set! double-open-count (sub1 double-open-count)))
     195                                 '(& "#x201d"))
     196                               (begin
     197                                 (when (fifth parts) (set! double-open-count (add1 double-open-count)))
     198                                 '(& "#x201c"))))
     199                          (else (error 'smarten-quotes "Unkown quote matching type: " (fourth parts))))))
     200                  (string-loop
     201                   after
     202                   ;; XXX don't use empty strings for before/pre and post
     203                   (append result-strings
     204                           (list (string-append before pre) new-quote post))))))))
    206205       (else (loop (cdr contents) (cons (car contents) result)))))))
    207206
  • release/3/fancypants/tests/run.scm

    r13975 r13976  
    2121(test-group "quote education"
    2222  (test '(p (*flatten* "Fatboy Slim is the band of the 90" (& "#x2019") "s" "!"))
    23         (smarten-quotes '(p "Fatboy Slim is the band of the 90's!")
    24                         all-quotes default-exceptions))
     23        (smarten-quotes '(p "Fatboy Slim is the band of the 90's!")))
    2524  (test '(p (*flatten* "What" (& "#x2019") "s" " that?"))
    26         (smarten-quotes '(p "What's that?") all-quotes default-exceptions))
     25        (smarten-quotes '(p "What's that?")))
    2726  (test '(p (*flatten* "" (& "#x201c") "" "We" (& "#x2019") "re" " going to need a bigger boat" (& "#x201d") "" ", he said"))
    28         (smarten-quotes '(p "\"We're going to need a bigger boat\", he said")
    29                         all-quotes default-exceptions))
     27        (smarten-quotes '(p "\"We're going to need a bigger boat\", he said")))
    3028  (test '(p (*flatten* "" (& "#x201c") "" "There" (& "#x2019") "s" " ") (em (*flatten* "no")) (*flatten* " business like show business" (& "#x201d") "" ""))
    3129        (smarten-quotes
    32          '(p "\"There's " (em "no") " business like show business\"")
    33          all-quotes default-exceptions)))
     30         '(p "\"There's " (em "no") " business like show business\"")))
     31  (test '(p (*flatten* "" (& "#x201c") "" "Hi there" (& "#x201d") "" ", he said"))
     32        (smarten-quotes '(p "``Hi there'', he said"))))
    3433
    3534(test-group "sxml rulesets"
Note: See TracChangeset for help on using the changeset viewer.