Changeset 12580 in project


Ignore:
Timestamp:
11/23/08 03:33:22 (13 years ago)
Author:
azul
Message:

Lots of more tests, more intelligence in providing list of possible paths to which the user can subscribe.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/svnwiki-mail/trunk/svnwiki-mail.scm

    r12576 r12580  
    333333;;; HTML form for subscribing
    334334
    335 ; TODO: Make sure this selects the default (the full path).
    336 
    337 (define (mail-request-subscribe-form-target env)
     335(define (remove-index path)
     336  (svnwiki-make-pathname
     337    (let ((original (string-split path "/")))
     338      (if (and (not (null? original))
     339               (string=? (last original) "index"))
     340        (butlast original)
     341        original))))
     342
     343(unittest (remove-index "foo/bar/index") "foo/bar")
     344(unittest (remove-index "foo/bar/xedni") "foo/bar/xedni")
     345(unittest (remove-index "") "")
     346(unittest (remove-index "index") "")
     347
     348(define (options-list-paths env)
    338349  (let-from-environment env (path user-input)
    339     (let ((default (string->stream
    340                      (svnwiki-mail-path-canonical
    341                        (stream->string
    342                          (user-input 'target
    343                                      (string->stream path)))))))
    344       (let loop ((path "/") (components (string-split (svnwiki-mail-path-canonical path) "/")))
     350    (let ((target (string->stream
     351                    (remove-index
     352                      (svnwiki-mail-path-canonical
     353                        (stream->string
     354                          (user-input 'target
     355                                      (string->stream path))))))))
     356      (let loop ((path "/")
     357                 (components (string-split (remove-index (svnwiki-mail-path-canonical path)) "/"))
     358                 (found-target #f))
    345359        (stream-delay
    346           (stream-append
    347             (if (stream= char=? default (string->stream (svnwiki-mail-path-canonical path)))
    348               (html-stream ((option value path selected "true") path))
    349               (html-stream ((option value path) path)))
    350             (if (null? components)
    351               stream-null
    352               (loop (svnwiki-make-pathname path (car components))
    353                     (cdr components)))))))))
     360          (let ((current-is-target (stream= char=? target (string->stream (svnwiki-mail-path-canonical path)))))
     361            (stream-cons
     362              ; If this is the last one and we haven't selected anything yet,
     363              ; select it: it's the most specific one we have.
     364              (list path (or current-is-target (and (not found-target) (null? components))))
     365              (if (null? components)
     366                stream-null
     367                (loop (svnwiki-make-pathname path (car components))
     368                      (cdr components)
     369                      (or current-is-target found-target))))))))))
     370
     371(unittest (stream->list
     372            (options-list-paths
     373              (environment ((path "foo/bar/hey")
     374                            (user-input (lambda (sym default) default))))))
     375          '(("/" #f) ("/foo" #f) ("/foo/bar" #f) ("/foo/bar/hey" #t)))
     376
     377(unittest (stream->list
     378            (options-list-paths
     379              (environment ((path "foo/bar/hey")
     380                            (user-input (lambda (sym default) (string->stream "something/else")))))))
     381          '(("/" #f) ("/foo" #f) ("/foo/bar" #f) ("/foo/bar/hey" #t)))
     382
     383(unittest (stream->list
     384            (options-list-paths
     385              (environment ((path "foo/bar/hey")
     386                            (user-input (lambda (sym default) (string->stream "/foo/bar")))))))
     387          '(("/" #f) ("/foo" #f) ("/foo/bar" #t) ("/foo/bar/hey" #f)))
     388
     389(unittest (stream->list
     390            (options-list-paths
     391              (environment ((path "foo/bar/hey")
     392                            (user-input (lambda (sym default) (string->stream "//qu/..///foo/./bar///")))))))
     393          '(("/" #f) ("/foo" #f) ("/foo/bar" #t) ("/foo/bar/hey" #f)))
     394
     395(unittest (stream->list
     396            (options-list-paths
     397              (environment ((path "foo/bar/index")
     398                            (user-input (lambda (sym default) (string->stream "//qu/..///foo/./bar///")))))))
     399          '(("/" #f) ("/foo" #f) ("/foo/bar" #t)))
     400
     401(define (subscribe-options->html options)
     402  (if (or (stream-null? options)
     403          (stream-null? (stream-cdr options)))
     404    (html-stream
     405      ((input type "hidden" name "target" value (car (stream-car options))))
     406      (tt (car (stream-car options))))
     407    (html-stream
     408      ((select name "target")
     409       (stream-concatenate
     410         (stream-map
     411           (lambda (data)
     412             (if (cadr data)
     413               (html-stream ((option value (car data) selected "true") (car data)))
     414               (html-stream ((option value (car data)) (car data)))))
     415           options))))))
     416
     417(unittest (stream->string (subscribe-options->html (stream '("/" #t))))
     418          (stream->string
     419            (html-stream
     420              ((input type "hidden" name "target" value "/"))
     421              (tt "/"))))
     422
     423(unittest (stream->string (subscribe-options->html (stream '("/" #t)' ("/foo" #f))))
     424          (stream->string
     425            (html-stream
     426              ((select name "target")
     427               ((option value "/" selected "true") "/")
     428               ((option value "/foo") "/foo")))))
     429
     430(unittest (stream->string (subscribe-options->html (stream '("/" #f)' ("/foo" #t))))
     431          (stream->string
     432            (html-stream
     433              ((select name "target")
     434               ((option value "/") "/")
     435               ((option value "/foo" selected "true") "/foo")))))
    354436
    355437(define (mail-request-subscribe-form env . rest)
     
    372454           (p "Subscribe to:"
    373455              (br)
    374               ((select name "target")
    375                (mail-request-subscribe-form-target env)))
     456              (subscribe-options->html (options-list-paths env)))
    376457           (p "If you want to also subscribe other people, enter their email addresses (separated by commas)."
    377458              (br)
Note: See TracChangeset for help on using the changeset viewer.