Changeset 14926 in project


Ignore:
Timestamp:
06/06/09 19:11:25 (10 years ago)
Author:
azul
Message:

Added some unit tests. Extended to allow us to work on translated documents (with a system similar to gettext). Other small improvements.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/stream-wiki/trunk/stream-wiki.scm

    r12885 r14926  
    2727    wiki-links
    2828    wiki-tags
     29    wiki-translations
    2930
    3031    ; Exports for extensions:
     
    4546  (usual-integrations))
    4647
    47 (use svnwiki-extensions-support srfi-1 srfi-13 srfi-14 srfi-40 stream-ext html-stream stream-parser posix format-modular stream-sections uri match)
     48(use svnwiki-extensions-support srfi-1 srfi-13 srfi-14 srfi-40 stream-ext html-stream stream-parser posix format-modular stream-sections uri match embedded-test)
    4849
    4950; An output driver is simply a table of functions.
     
    169170      (let ((dst-real (stream-find check-exists? (parse-link-file dst-file))))
    170171        (if dst-real
    171           (values "internal" (url-adjust (stream-append dst-real (fix-suffix dst-suffix))))
    172           (values "unexistant" (name-to-base dst-file)))))))
     172          (values 'internal (url-adjust (stream-append dst-real (fix-suffix dst-suffix))))
     173          (values 'unexistant (name-to-base dst-file)))))))
    173174
    174175(define (parse-link-file file)
     
    191192    (constantly stream-null)
    192193    ; header
    193     (lambda (name depth id text)
    194       (stream-traverse text)
     194    (lambda (name parse depth id text)
     195      (stream-traverse (parse name))
     196      (stream-traverse (parse text))
    195197      stream-null)
    196198    ; blockquote
     
    207209    (compose (constantly stream-null) stream-traverse)
    208210    ; paragraph
    209     (compose (constantly stream-null) stream-traverse)
     211    (lambda (text parse)
     212      (stream-traverse (parse text))
     213      stream-null)
    210214    ; strong
    211215    (compose (constantly stream-null) stream-traverse)
     
    223227    (compose (constantly stream-null) stream-traverse)
    224228    ; list-item
    225     (compose (constantly stream-null) stream-traverse)
     229    (lambda (text parse tail)
     230      (stream-traverse (parse text))
     231      (stream-traverse tail)
     232      stream-null)
    226233    ; definition-list
    227234    (compose (constantly stream-null) stream-traverse)
     
    244251    (constantly stream-null)))
    245252
     253;;; Translations driver
     254
     255; TODO: Move this to the svnwiki-translations egg.
     256
     257(define (translate-driver proc driver)
     258  (if proc
     259    (make-driver
     260      (driver-output-format driver)
     261      ; horizontal line
     262      (driver-horizontal-line driver)
     263      ; make header
     264      (lambda (name parse depth id text)
     265        ((driver-header driver) (proc name) parse depth id text))
     266      ; blockquote
     267      (driver-blockquote driver)
     268      ; center
     269      (driver-center driver)
     270      ; small
     271      (driver-small driver)
     272      ; big
     273      (driver-big driver)
     274      ; literal
     275      (driver-literal driver)
     276      ; literal-line
     277      (driver-literal-line driver)
     278      ; paragraph
     279      (lambda (name parse)
     280        ((driver-paragraph driver) (proc name) parse))
     281      ; strong
     282      (driver-strong driver)
     283      ; emphasis
     284      (driver-em driver)
     285      ; link
     286      (driver-link driver)
     287      ; image
     288      (driver-image driver)
     289      ; math
     290      (driver-math driver)
     291      ; ordered list
     292      (driver-ordered-list driver)
     293      ; bullets list
     294      (driver-unordered-list driver)
     295      ; list item
     296      (lambda (text parse tail)
     297        ((driver-list-item driver) (proc text) parse tail))
     298      ; definition list
     299      (driver-definition-list driver)
     300      ; definition
     301      (driver-definition-item driver)
     302      ; toc
     303      (driver-toc driver)
     304      ; special-char
     305      (driver-special-char driver)
     306      ; tags
     307      (driver-tags driver)
     308      ; comments
     309      (driver-comment driver)
     310      ; line-break
     311      (driver-line-break driver)
     312      (driver-anchor driver))
     313    driver))
     314
     315(test-group translate-driver
     316  (test (stream->string
     317          (wiki->text
     318            (string->stream "== there\n\n* foo\n\nfoo\n\nbar\n\nbar\n\nthere\n\n")
     319            #t
     320            stream-null
     321            ""
     322            (constantly stream-null)
     323            (lambda (n t) t)
     324            (make-hash-table)
     325            (environment ())
     326            (lambda (x)
     327              (string->stream
     328                (cadr (assoc (stream->string x)
     329                             '(("there" "THERE") ("foo" "FOO") ("bar" "BAR"))))))))
     330        "THERE\n\n* FOO\n\nFOO\n\nBAR\n\nBAR\n\nTHERE\n\n"))
     331
     332(define (translations-list-driver return)
     333  (make-driver
     334    ; format
     335    'translations
     336    ; horizontal-line
     337    (constantly stream-null)
     338    ; header
     339    (lambda (name parse depth id text)
     340      (return (list name text))
     341      stream-null)
     342    ; blockquote
     343    (compose (constantly stream-null) stream-traverse)
     344    ; center
     345    (compose (constantly stream-null) stream-traverse)
     346    ; small
     347    (compose (constantly stream-null) stream-traverse)
     348    ; big
     349    (compose (constantly stream-null) stream-traverse)
     350    ; literal
     351    (compose (constantly stream-null) stream-traverse)
     352    ; literal-line
     353    (compose (constantly stream-null) stream-traverse)
     354    ; paragraph
     355    (lambda (text parse)
     356      text)
     357    ; strong
     358    (compose (constantly stream-null) stream-traverse)
     359    ; em
     360    (compose (constantly stream-null) stream-traverse)
     361    ; link
     362    (constantly stream-null)
     363    ; image
     364    (constantly stream-null)
     365    ; math
     366    (constantly stream-null)
     367    ; ordered-list
     368    (compose (constantly stream-null) stream-traverse)
     369    ; unordered-list
     370    (compose (constantly stream-null) stream-traverse)
     371    ; list-item
     372    (lambda (text parse tail)
     373      (stream-traverse (parse text))
     374      (stream-traverse tail)
     375      stream-null)
     376    ; definition-list
     377    (compose (constantly stream-null) stream-traverse)
     378    ; definition-item
     379    (lambda (t d)
     380      (stream-traverse t)
     381      (stream-traverse d)
     382      stream-null)
     383    ; toc
     384    (constantly stream-null)
     385    ; special-char
     386    (constantly stream-null)
     387    ; tags
     388    (constantly stream-null)
     389    ; comments
     390    (constantly stream-null)
     391    ; line-break
     392    (constantly stream-null)
     393    ; anchor
     394    (constantly stream-null)))
     395
     396
    246397;;; OpenOffice.org Driver
    247398
     
    252403    'open-document-format
    253404    (constantly (html-stream (hr)))
    254     (lambda (name depth id text)
     405    (lambda (name parse depth id text)
    255406      (stream-append
    256407        (html-stream ((a name (text->html-id name))))
     
    266417    (tags-func pre)
    267418    (tags-func tt)
    268     (tags-func p)
     419    (lambda (text parse)
     420      ((tags-func p) (parse text)))
    269421    (tags-func strong)
    270422    (tags-func em)
     
    302454(define (make-html-header . rest)
    303455  (let-optionals rest ((header-start 1))
    304     (lambda (name depth id text)
     456    (lambda (name parse depth id text)
    305457      (html-stream
    306458        ((a name (text->html-id id)))
    307459        (string->stream (format #f "<h~A>" (min 6 (+ depth header-start))))
    308         name
     460        (parse name)
    309461        (string->stream (format #f "</h~A>" (min 6 (+ depth header-start))))
    310462        text))))
     
    316468           (parse-link dst check-exists? url-adjust)
    317469    (assert (and html-driver-link '(stream? dst-real)))
    318     (if (and (eq? type 'external)
    319              (no-follow? dst-real))
     470    (if (or (eq? type 'unexistant)
     471            (and (eq? type 'external)
     472                 (no-follow? dst-real)))
    320473      (html-stream ((a href dst-real class type rel "nofollow") name))
    321474      (html-stream ((a href dst-real class type) name)))))
     
    380533    (tags-func tt)
    381534    ; paragraph
    382     (tags-func p)
     535    (lambda (text parse)
     536      ((tags-func p) (parse text)))
    383537    ; strong
    384538    (tags-func strong)
     
    399553    (tags-func ul)
    400554    ; list item
    401     (tags-func li)
     555    (lambda (text parse tail)
     556      (html-stream
     557        (li (parse text) tail)))
    402558    ; definition list
    403559    (tags-func dl)
     
    471627      (constantly stream-null))
    472628    ; make header
    473     (lambda (name depth id text)
    474       (stream-append name (stream #\newline #\newline) text))
     629    (lambda (name parse depth id text)
     630      (stream-append (parse name) (stream #\newline #\newline) text))
    475631    ; blockquote
    476632    (if human-readable
     
    489645    identity
    490646    ; paragraph
    491     (lambda (text)
     647    (lambda (text parse)
    492648      (assert (stream? text))
    493       (stream-append text (stream #\newline #\newline)))
     649      (stream-append (parse text) (stream #\newline #\newline)))
    494650    ; strong
    495651    identity
     
    519675    identity
    520676    ; list item
    521     (lambda (item)
     677    (lambda (item parse tail)
    522678      ; TODO: Somehow get the depth right!
    523679      (stream-append
    524680        (if human-readable (stream #\* #\space) stream-null)
    525         item
    526         (stream #\newline #\newline)))
     681        (parse item)
     682        (stream #\newline #\newline)
     683        tail))
    527684    ; definition list
    528685    identity
     
    583740    (constantly stream-null)
    584741    ; header
    585     (lambda (name depth id text)
    586       (stream-traverse text)
     742    (lambda (name parse depth id text)
     743      (stream-traverse (parse text))
    587744      stream-null)
    588     (compose (constantly stream-null) stream-traverse)
    589     (compose (constantly stream-null) stream-traverse)
    590     (compose (constantly stream-null) stream-traverse)
    591     (compose (constantly stream-null) stream-traverse)
    592     (compose (constantly stream-null) stream-traverse)
    593     (compose (constantly stream-null) stream-traverse)
    594     (compose (constantly stream-null) stream-traverse)
    595     (compose (constantly stream-null) stream-traverse)
    596     (compose (constantly stream-null) stream-traverse)
     745    ; blockquote
     746    (compose (constantly stream-null) stream-traverse)
     747    ; center
     748    (compose (constantly stream-null) stream-traverse)
     749    ; small
     750    (compose (constantly stream-null) stream-traverse)
     751    ; big
     752    (compose (constantly stream-null) stream-traverse)
     753    ; literal
     754    (compose (constantly stream-null) stream-traverse)
     755    ; literal-line
     756    (compose (constantly stream-null) stream-traverse)
     757    ; paragraph
     758    (lambda (text parse)
     759      (stream-traverse (parse text))
     760      stream-null)
     761    ; strong
     762    (compose (constantly stream-null) stream-traverse)
     763    ; em
     764    (compose (constantly stream-null) stream-traverse)
     765    ; link
    597766    (lambda (dst name)
    598767      (register (list (stream-take-while (complement (conjoin (cut char=? <> #\|) (cut char=? <> #\#))) dst) name))
    599768      stream-null)
    600     (constantly stream-null)
    601     (constantly stream-null)
    602     (compose (constantly stream-null) stream-traverse)
    603     (compose (constantly stream-null) stream-traverse)
    604     (compose (constantly stream-null) stream-traverse)
    605     (compose (constantly stream-null) stream-traverse)
     769    ; image
     770    (constantly stream-null)
     771    ; math
     772    (constantly stream-null)
     773    ; ordered-list
     774    (compose (constantly stream-null) stream-traverse)
     775    ; bullets-list
     776    (compose (constantly stream-null) stream-traverse)
     777    ; list-item
     778    (lambda (text parse tail)
     779      (stream-traverse (parse text))
     780      (stream-traverse tail)
     781      stream-null)
     782    ; definition-list
     783    (compose (constantly stream-null) stream-traverse)
     784    ; definition
    606785    (lambda (t d)
    607786      (stream-traverse t)
     
    628807    (constantly stream-null)
    629808    ; header
    630     (lambda (name depth id text)
    631       (stream-traverse text)
     809    (lambda (name parse depth id text)
     810      (stream-traverse (parse text))
    632811      stream-null)
    633     (compose (constantly stream-null) stream-traverse)
    634     (compose (constantly stream-null) stream-traverse)
    635     (compose (constantly stream-null) stream-traverse)
    636     (compose (constantly stream-null) stream-traverse)
    637     (compose (constantly stream-null) stream-traverse)
    638     (compose (constantly stream-null) stream-traverse)
    639     (compose (constantly stream-null) stream-traverse)
    640     (compose (constantly stream-null) stream-traverse)
    641     (compose (constantly stream-null) stream-traverse)
    642     (constantly stream-null)
    643     (constantly stream-null)
    644     (constantly stream-null)
    645     (compose (constantly stream-null) stream-traverse)
    646     (compose (constantly stream-null) stream-traverse)
    647     (compose (constantly stream-null) stream-traverse)
    648     (compose (constantly stream-null) stream-traverse)
     812    ; blockquote
     813    (compose (constantly stream-null) stream-traverse)
     814    ; center
     815    (compose (constantly stream-null) stream-traverse)
     816    ; small
     817    (compose (constantly stream-null) stream-traverse)
     818    ; big
     819    (compose (constantly stream-null) stream-traverse)
     820    ; literal
     821    (compose (constantly stream-null) stream-traverse)
     822    ; literal-line
     823    (compose (constantly stream-null) stream-traverse)
     824    ; paragraph
     825    (lambda (text parse)
     826      (assert (stream? text))
     827      (stream-traverse (parse text))
     828      stream-null)
     829    ; strong
     830    (compose (constantly stream-null) stream-traverse)
     831    ; em
     832    (compose (constantly stream-null) stream-traverse)
     833    ; link
     834    (constantly stream-null)
     835    ; image
     836    (constantly stream-null)
     837    ; math
     838    (constantly stream-null)
     839    ; ordered-list
     840    (compose (constantly stream-null) stream-traverse)
     841    ; bullets-list
     842    (compose (constantly stream-null) stream-traverse)
     843    ; list-item
     844    (lambda (text parse tail)
     845      (stream-traverse (parse text))
     846      (stream-traverse tail)
     847      stream-null)
     848    ; definition
     849    (compose (constantly stream-null) stream-traverse)
     850    ; definition-list
    649851    (lambda (t d)
    650852      (stream-traverse t)
     
    718920    ; make header
    719921    (let ((add (if (or (string=? class "book") (string=? class "report")) 0 1)))
    720       (lambda (name depth id text)
     922      (lambda (name parse depth id text)
    721923        (stream-append
    722924          (let ((real-depth (+ depth add)))
     
    749951    (latex-wrap "\\verb|" "|")
    750952    ; paragraph
    751     (latex-wrap "" "\n\n")
     953    (lambda (text parse)
     954      (assert (stream? text))
     955      (stream-append (parse text) "\n\n"))
    752956    ; strong
    753957    (latex-wrap "\\textbf{" "}")
     
    776980    (latex-environment 'itemize)
    777981    ; list item
    778     (latex-wrap "\\item " "\n\n")
     982    (lambda (text parse tail)
     983      (stream-append
     984        (string->stream "\\item ")
     985        (parse text)
     986        tail
     987        (string->stream "\n\n")))
    779988    ; definition list
    780989    (latex-environment 'description)
     
    11041313        (assert (not (and (stream-null? head) (stream-null? tail)))))
    11051314       (wikidata-list-item info
    1106          (stream-append
    1107            (if (stream-null? head)
    1108              stream-null
    1109              (parse-all
    1110                (stream-reverse
    1111                  (stream-drop-while
    1112                    char-whitespace?
    1113                    (stream-reverse text)))
    1114                (lambda () (error "foo"))
    1115                (text-transform info #f #f #f #f #\space)))
    1116            (if (stream-null? tail)
    1117              stream-null
    1118              (parse-all tail fail (list-transform info current)))))))))
     1315         (if (stream-null? head)
     1316           stream-null
     1317           (stream-reverse
     1318             (stream-drop-while
     1319               char-whitespace?
     1320               (stream-reverse text))))
     1321         (cut parse-all
     1322              <>
     1323              (lambda () (error "foo"))
     1324              (text-transform info #f #f #f #f #\space))
     1325         (if (stream-null? tail)
     1326           stream-null
     1327           (parse-all tail fail (list-transform info current))))))))
    11191328
    11201329(define (definition-list info)
     
    11671376       (wikidata-header
    11681377         info
    1169          (parse-all
    1170            name
    1171            (lambda () (error "noparse" (stream->string name)))
    1172            (text-transform info #f #f #f #f #\space))
     1378         name
     1379         (lambda (name)
     1380           (parse-all
     1381             name
     1382             (lambda () (error "noparse" (stream->string name)))
     1383             (text-transform info #f #f #f #f #\space)))
    11731384         (min 5 (stream-length (stream-cdr depth)))
    11741385         (sections-accept-new-name! (wikidata-previous-sections info) name)
     
    12661477
    12671478      (((bind text (+all (not (or #\space #\newline #\> #\* #\# (#\= #\=))) (all (not #\newline)) (or #\newline ((end))))))
    1268        (let ((text (parse-all text (lambda () (error "noparse" (stream->string (stream-reverse (stream-cdr text))))) (text-transform info #f #f #f #f #\space))))
    1269          (if (stream-null? text)
    1270            stream-null
    1271            (wikidata-paragraph info text)))))))
     1479       (if (stream-null? text)
     1480         stream-null
     1481         (wikidata-paragraph
     1482           info
     1483           (stream-reverse
     1484             (stream-drop-while
     1485               char-whitespace?
     1486               (stream-reverse
     1487                 (stream-drop-while
     1488                   char-whitespace?
     1489                   text))))
     1490           (lambda (text)
     1491             (parse-all
     1492               text
     1493               (lambda () (error "noparse" (stream->string (stream-reverse (stream-cdr text)))))
     1494               (text-transform info #f #f #f #f #\space)))))))))
    12721495
    12731496(define (accum-with-driver driver)
     
    12851508  (accum-with-driver tags-driver))
    12861509
     1510(define wiki-translations
     1511  (accum-with-driver translations-list-driver))
     1512 
    12871513(define (wiki-extension name . rest)
    12881514  (stream-traverse
     
    13651591(define (wiki->html str . rest)
    13661592  (stream-delay
    1367     (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (make-header (make-html-header)) (data-output-func (constantly stream-null)) (check-exists? (constantly #t)) (url-adjust identity) (environment (environment ())) (no-follow? (constantly #f)))
    1368       (wiki-parse (html-driver make-header data-output-func check-exists? url-adjust no-follow?) str tail name open include linktypes environment))))
     1593    (let-optionals rest ((tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (make-header (make-html-header)) (data-output-func (constantly stream-null)) (check-exists? (constantly #t)) (url-adjust identity) (environment (environment ())) (no-follow? (constantly #f)) (translator-proc #f))
     1594      (wiki-parse (translate-driver translator-proc (html-driver make-header data-output-func check-exists? url-adjust no-follow?)) str tail name open include linktypes environment))))
    13691595
    13701596(define (wiki->text str . rest)
    13711597  (stream-delay
    1372     (let-optionals rest ((human-readable #t) (tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (environment (environment ())))
    1373       (wiki-parse (text-driver human-readable) str tail name open include linktypes environment))))
     1598    (let-optionals rest ((human-readable #t) (tail stream-null) (name "") (open (constantly stream-null)) (include (lambda (name tail) tail)) (linktypes (make-hash-table)) (environment (environment ())) (translator-proc #f))
     1599      (wiki-parse (translate-driver translator-proc (text-driver human-readable)) str tail name open include linktypes environment))))
    13741600
    13751601(define (wiki->latex str . rest)
     
    17041930     (constantly stream-null)
    17051931     ;; make header
    1706      (lambda (name depth id text)
     1932     (lambda (name parse depth id text)
    17071933       (let ((up-node (and (positive? depth) (vector-ref last-at-depth (- depth 1)))))
    17081934         (stream-append
     
    17421968     (texi-wrap "@code{" "}")
    17431969     ;; paragraph
    1744      (texi-wrap "" "\n\n")
     1970     (lambda (text parse)
     1971       (assert (stream? text))
     1972       (stream-append (parse text) "\n\n"))
    17451973     ;; strong
    17461974     (texi-wrap "@b{" "}")
     
    17782006     ;; bullets list
    17792007     (texi-wrap "@itemize\n" "\n@end itemize\n")
    1780      ;; list item
    1781      (texi-wrap "@item " "\n\n")
     2008     ; list item
     2009     (lambda (text parse tail)
     2010       (stream-append
     2011         (string->stream "@item ")
     2012         (parse text)
     2013         tail
     2014         (string->stream "\n\n")))
    17822015     ;; definition list
    17832016     (texi-wrap "@table @b\n" "\n@end table\n")
     
    18932126       (constantly stream-null)
    18942127       ;; make header
    1895        (lambda (name depth id text)
     2128       (lambda (name parse depth id text)
    18962129         (let* ((up-node    (and (positive? depth) (vector-ref last-at-depth (- depth 1))))
    18972130                (sym        (string->symbol (escape-texi-node-name (stream->string name) up-node)))
     
    19392172       ;; The text "Next: " or "Previous: ", followed by a link serves to
    19402173       ;; override the default prev/next nodes on level 0
    1941        (lambda (x)
     2174       (lambda (x parse)
    19422175         (cond ((and (<= 6 (stream-length x))
    19432176                     (string=? "Next: " (stream->string (stream-take x 6))))
     
    19792212       (constantly stream-null)
    19802213       (constantly stream-null)
     2214       ; list-item
    19812215       (constantly stream-null)
     2216       ; definition-list
    19822217       (constantly stream-null)
     2218       ; definition-term
    19832219       (constantly stream-null)
    19842220       ;; toc
Note: See TracChangeset for help on using the changeset viewer.