Changeset 15456 in project


Ignore:
Timestamp:
08/14/09 06:12:52 (10 years ago)
Author:
Ivan Raikov
Message:

streamlining of wiki link parsing; added some simle test cases

Location:
release/4/wiki-parse
Files:
6 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/wiki-parse/wiki-parse.meta

    r15305 r15456  
    1818 ; A list of eggs wiki-parse depends on.
    1919
    20  (needs html-parser)
     20 (needs html-parser uri-common)
    2121 (test-depends test)
    2222
  • release/4/wiki-parse/wiki-parse.scm

    r15449 r15456  
    33;;
    44;; Based on wiki-parse.scm by Alex Shinn. Modified for svnwiki syntax
    5 ;; by Ivan Raikov.
     5;; by Ivan Raikov and Peter Bex.
    66;;
    7 ;; Copyright 2009 Alex Shinn, Ivan Raikov.
     7;; Copyright 2009 Alex Shinn, Ivan Raikov, Peter Bex.
    88;;
    99;;
     
    4646        (import scheme chicken irregex)
    4747
    48         (require-extension extras regex data-structures srfi-1 srfi-13 html-parser)
     48        (require-extension extras regex data-structures srfi-1 srfi-13)
     49        (require-extension html-parser uri-common)
    4950
    5051(define (safe-assoc k lst)
     
    154155        (wiki-col-rx
    155156         (irregex "\\|\\|"))
    156         (wiki-named-url-rx
    157          (irregex "\\[\\[((?:https?|ftp):/+[\\-+.,_/%?&~=:\\w]+[\\-+_/%?&~=:\\w])\\|[ \t\n]*([^\\]]*)\\]\\]"))
    158         (wiki-url-rx
    159          (irregex "((?:https?|ftp):/+[\\-+.,_/%?&~=:\\w]+[\\-+_/%?&~=:\\w])"))
    160         (wiki-special-rx
    161          (irregex "\\[\\[([a-z]+):([^\\]]*)\\]\\]"))       
    162         (wiki-word-rx
    163          (irregex "\\[\\[([^\\]|]+)(?:\\| *([^\\]|]+))?\\]\\]")))
     157        (wiki-link-rx
     158         (irregex "(\\[\\[)((([^\\|\\]])+)((\\|)([^\\]]+))*)(\\]\\])"))
     159        (wiki-special-rx
     160         (irregex "([^:]+)(:)(.*)"))
     161        )
    164162    (lambda (str)
    165163      (irregex-multi-fold
     
    205203                   (wiki-parse-inline (irregex-match-substring m 1))
    206204                   #f)))
    207          (,wiki-named-url-rx
     205
     206         (,wiki-link-rx
    208207          ,(lambda (m)
    209              (list 'url
    210                    (irregex-match-substring m 1)
    211                    (irregex-match-substring m 2))))
    212          (,wiki-url-rx
    213           ,(lambda (m)
    214              (list 'url
    215                    (irregex-match-substring m 1)
    216                    (irregex-match-substring m 1))))
    217          (,wiki-special-rx
    218           ,(lambda (m) (list 'special (string->symbol (irregex-match-substring m 1))
    219                              (string-trim-both (irregex-match-substring m 2)))))
    220          (,wiki-word-rx
    221           ,(lambda (m)
    222              (list 'wiki
    223                    (irregex-match-substring m 1)
    224                    (irregex-match-substring m 2))))
     208             (let ((m2 (irregex-match-substring m 2))
     209                   (m3 (irregex-match-substring m 3))
     210                   (m7 (or (irregex-match-substring m 7) "")))
     211               (cond ((uri-reference m3) =>
     212                      ;; Case 1: wiki-link is a possible URI reference
     213                      (lambda (u)
     214                        ;; If the wiki-link is a valid URI,
     215                        ;; then it could be an absolute URI,
     216                        ;; a local wiki link,
     217                        ;; or a special tag of the form [[tag: value]]
     218                        (if (relative-ref? u)
     219                            ;; Case 1.1: the URI does not contain any
     220                            ;; scheme  (relative reference)
     221                            (list 'wiki m3 m7)
     222                            ;; Case 1.2: the URI is absolute, or a special tag
     223                            (case (uri-scheme u)
     224                              ;; Case 1.2.1: the URI contains a valid scheme name
     225                              ((http https ftp)
     226                               (list 'url m3 m7))
     227                              ;; Case 1.2.2: the URI does not contain a
     228                              ;; valid scheme name, and is therefore a
     229                              ;; special tag
     230                              (else (list 'special (uri-scheme u)
     231                                          (string-trim-both m7)))))))
     232                     ;; Case 2: wiki-link is not a valid URI; if the
     233                     ;; link-name contains colon, we treat it as a
     234                     ;; special tag, otherwise as a link to a local
     235                     ;; wiki page
     236                     (else
     237                      (cond ((irregex-search wiki-special-rx m2) =>
     238                             (lambda (m) 
     239                               (list 'special (string->symbol (irregex-match-substring m 1))
     240                                     (string-trim-both (irregex-match-substring m 3)))))
     241                            (else (list 'wiki m3 m7)))))
     242                     )))
     243
    225244         (,wiki-blockquote-rx
    226245          ,(lambda (m) (list 'blockquote (irregex-match-substring m 1))))
     
    248267         (irregex "^=(=+)[ \\t]*([^=]+)([=]*)$"))
    249268        (wiki-def-rx
    250          (irregex ";[ \\t]+([^:]+)[ \\t]+:[ \\t]+(.*)$"))
     269         (irregex ";[ \\t]+(\\[\\[.*\\]\\]|([^:]+))[ \\t]+:[ \\t]+(.*)$"))
    251270        (wiki-nowiki-start-rx
    252271         (irregex "<nowiki>(.*)"))
     
    321340              => (lambda (m)
    322341                   (let* ((t (irregex-match-substring m 1))
    323                           (d (irregex-match-substring m 2)))
     342                          (d (irregex-match-substring m 3)))
    324343                     (parse res par list-level (cons (list t d) defns)))))
    325344
Note: See TracChangeset for help on using the changeset viewer.