Changeset 14263 for lang/gauche

Show
Ignore:
Timestamp:
06/19/08 22:01:57 (5 months ago)
Author:
kiyoka
Message:

Created unit test of plain text layouter.

Location:
lang/gauche/oldtype/trunk
Files:
4 modified

Legend:

Unmodified
Added
Removed

  • lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/format.scm

    r14228 r14263  
    5252          oldtype:expand-page 
    5353          oldtype:format-line-plainly 
    54           oldtype:oldtype-page->plain-text 
    55   )) 
     54          oldtype:sxml->plain-text 
     55          )) 
    5656(select-module oldtype.format) 
    5757 
    … …  
    113113 
    114114 
    115 (define (oldtype:oldtype-page->plain-text sxmls) 
    116   (let rec 
    117       ((sxmls sxmls)) 
    118     (match sxmls 
    119            (()  '()) 
    120            (((and (name . _) sxml) . rest) ;; generic node 
    121             (let1 arg (cdr sxml) 
    122                   (cons 
    123                    (case name 
    124                      ((div) 
    125                       (let* ((param (car arg)) ;; param is assoc-list 
    126                              (lineno (assq-ref param 'lineno))) 
    127                         (rec (cdr arg)))) 
    128                      ((a) 
    129                       (let1 param (car arg) ;; param is assoc-list 
    130                             (rec (cdr arg)))) 
    131                      ((p-normal)    (rec arg)) 
    132                      ((pre-quote)   (rec arg)) 
    133                      ((pre-verb)    (rec arg)) 
    134                      ((pre-ul1)     (cons "- "     (rec arg))) 
    135                      ((pre-ul2)     (cons "-- "    (rec arg))) 
    136                      ((pre-ul3)     (cons "--- "   (rec arg))) 
    137                      ((pre-ol1)     (cons "# "     (rec arg))) 
    138                      ((pre-ol2)     (cons "## "    (rec arg))) 
    139                      ((pre-ol3)     (cons "### "   (rec arg))) 
    140                      ((h1)          (cons "[] "    (rec (cdr arg)))) 
    141                      ((h2)          (cons "* "     (rec (cdr arg)))) 
    142                      ((h3)          (cons "** "    (rec (cdr arg)))) 
    143                      ((h4)          (cons "*** "   (rec (cdr arg)))) 
    144                      ((h5)          (cons "**** "  (rec (cdr arg)))) 
    145                      ((h6)          (cons "***** " (rec (cdr arg)))) 
    146                      ((wiki-macro)  (oldtype:wiki-macro->plain arg)) 
    147                      ((wiki-name)   (oldtype:wikiname->plain (car arg))) 
    148                      ((hr)          (list "----\n")) 
    149                      (else 
    150                       (format "!!Error : no such tag \"~a\"!!" name))) 
    151                    (rec rest)))) 
    152            ((other . rest) 
    153             (cons other (rec rest)))))) 
     115(define (oldtype:sxml->plain-text sxmls) 
     116  (tree->string 
     117   (let rec 
     118       ((sxmls sxmls)) 
     119     (match sxmls 
     120            (()  '()) 
     121            (((and (name . _) sxml) . rest) ;; generic node 
     122             (let1 arg (cdr sxml) 
     123                   (cons 
     124                    (case name 
     125                      ((div) 
     126                       (let* ((param (car arg)) ;; param is assoc-list 
     127                              (lineno (assq-ref param 'lineno))) 
     128                         (rec (cdr arg)))) 
     129                      ((a) 
     130                       (let1 param (car arg) ;; param is assoc-list 
     131                             (rec (cdr arg)))) 
     132                      ((p-normal)    (rec arg)) 
     133                      ((pre-quote)   (rec arg)) 
     134                      ((pre-verb)    (rec arg)) 
     135                      ((pre-ul1)     (cons "- "     (rec arg))) 
     136                      ((pre-ul2)     (cons "-- "    (rec arg))) 
     137                      ((pre-ul3)     (cons "--- "   (rec arg))) 
     138                      ((pre-ol1)     (cons "# "     (rec arg))) 
     139                      ((pre-ol2)     (cons "## "    (rec arg))) 
     140                      ((pre-ol3)     (cons "### "   (rec arg))) 
     141                      ((h1)          (cons "[] "    (rec (cdr arg)))) 
     142                      ((h2)          (cons "* "     (rec (cdr arg)))) 
     143                      ((h3)          (cons "** "    (rec (cdr arg)))) 
     144                      ((h4)          (cons "*** "   (rec (cdr arg)))) 
     145                      ((h5)          (cons "**** "  (rec (cdr arg)))) 
     146                      ((h6)          (cons "***** " (rec (cdr arg)))) 
     147                      ((wiki-macro)  (oldtype:wiki-macro->plain arg)) 
     148                      ((wiki-name)   (oldtype:wikiname->plain (car arg))) 
     149                      ((hr)          (list "----\n")) 
     150                      (else 
     151                       (format "!!Error : no such tag \"~a\"!!" name))) 
     152                    (rec rest)))) 
     153            ((other . rest) 
     154             (cons other (rec rest))))))) 
    154155 
    155156 

  • lang/gauche/oldtype/trunk/Kahua/oldtype/oldtype/page.scm

    r13617 r14263  
    7474   (timeline    :accessor timeline-of    :init-keyword :timeline 
    7575                :init-value '()) 
     76   ;; vector of text in page 
     77   (plain       :accessor plain-of       :init-keyword :plain 
     78                :init-value '()) 
    7679   )) 
    7780 
    … …  
    8487        (oldtype:sxml->internal 
    8588         (oldtype-parse wiki-port))) 
     89  (set! (plain-of self) 
     90        (list->vector 
     91         (string-split  
     92          (oldtype:sxml->plain-text (sxml-of self)) 
     93          #\newline))) 
    8694  self) 
    8795 
    … …  
    9199    (name     . ,(name-of     self)) 
    92100    (sxml     . ,(sxml-of     self)) 
    93     (timeline . ,(serialize (timeline-of self))))) 
    94  
     101    (timeline . ,(serialize (timeline-of self))) 
     102    (plain    . ,(vector->list (plain-of self))))) 
     103                   
    95104 
    96105(define-method deserialize ((dummy <oldtype-page>) internal-data) 
    … …  
    98107    :name      (assq-ref internal-data 'name) 
    99108    :sxml      (assq-ref internal-data 'sxml) 
    100     :timeline  (deserialize (make <oldtype-timeline>) (assq-ref internal-data 'timeline)))) 
    101    
     109    :timeline  (deserialize (make <oldtype-timeline>) (assq-ref internal-data 'timeline)) 
     110    :plain     (list->vector (assq-ref internal-data 'plain)))) 
     111 
    102112 
    103113(define-method get-revision ((self <oldtype-page>) lineno) 

  • lang/gauche/oldtype/trunk/src/oldtype_to

    r14228 r14263  
    159159       (let* ( 
    160160              (sxml           (oldtype-parse input-port)) 
    161               (sexp           (oldtype:oldtype-page->plain-text sxml))) 
     161              (sexp           (oldtype:sxml->plain-text sxml))) 
    162162         (print 
    163163          (tree->string 

  • lang/gauche/oldtype/trunk/src/test.scm

    r13617 r14263  
    4646                    '((name . "Test") (revision . 13317) 
    4747                      (log 
     48                       (14228 (revision . 14228) (committer . kiyoka) (utc . 1213799971) (rank . 5)) 
     49                       (14139 (revision . 14139) (committer . kiyoka) (utc . 1213628604) (rank . 5)) 
     50                       (14128 (revision . 14128) (committer . kiyoka) (utc . 1213618410) (rank . 5)) 
     51                       (13660 (revision . 13660) (committer . kiyoka) (utc . 1213192900) (rank . 5)) 
     52                       (13658 (revision . 13658) (committer . kiyoka) (utc . 1213187139) (rank . 5)) 
     53                       (13617 (revision . 13617) (committer . kiyoka) (utc . 1213099402) (rank . 5)) 
     54                       (13593 (revision . 13593) (committer . kiyoka) (utc . 1213022881) (rank . 5)) 
     55                       (13549 (revision . 13549) (committer . kiyoka) (utc . 1212939281) (rank . 5)) 
     56                       (13545 (revision . 13545) (committer . kiyoka) (utc . 1212938686) (rank . 5)) 
     57                       (13542 (revision . 13542) (committer . kiyoka) (utc . 1212938495) (rank . 5)) 
     58                       (13390 (revision . 13390) (committer . kiyoka) (utc . 1212833561) (rank . 5)) 
     59                       (13389 (revision . 13389) (committer . kiyoka) (utc . 1212833492) (rank . 5)) 
    4860                       (13334 (revision . 13334) (committer . kiyoka) (utc . 1212756234) (rank . 5)) 
    4961                       (13317 (revision . 13317) (committer . kiyoka) (utc . 1212711085) (rank . 3)) 
    … …  
    141153                    (timeline (name . "Test") (revision . 13317) 
    142154                              (log 
     155                               (14228 (revision . 14228) (committer . kiyoka) (utc . 1213799971) (rank . 5)) 
     156                               (14139 (revision . 14139) (committer . kiyoka) (utc . 1213628604) (rank . 5)) 
     157                               (14128 (revision . 14128) (committer . kiyoka) (utc . 1213618410) (rank . 5)) 
     158                               (13660 (revision . 13660) (committer . kiyoka) (utc . 1213192900) (rank . 5)) 
     159                               (13658 (revision . 13658) (committer . kiyoka) (utc . 1213187139) (rank . 5)) 
     160                               (13617 (revision . 13617) (committer . kiyoka) (utc . 1213099402) (rank . 5)) 
     161                               (13593 (revision . 13593) (committer . kiyoka) (utc . 1213022881) (rank . 5)) 
     162                               (13549 (revision . 13549) (committer . kiyoka) (utc . 1212939281) (rank . 5)) 
     163                               (13545 (revision . 13545) (committer . kiyoka) (utc . 1212938686) (rank . 5)) 
     164                               (13542 (revision . 13542) (committer . kiyoka) (utc . 1212938495) (rank . 5)) 
     165                               (13390 (revision . 13390) (committer . kiyoka) (utc . 1212833561) (rank . 5)) 
     166                               (13389 (revision . 13389) (committer . kiyoka) (utc . 1212833492) (rank . 5)) 
    143167                               (13334 (revision . 13334) (committer . kiyoka) (utc . 1212756234) (rank . 5)) 
    144168                               (13317 (revision . 13317) (committer . kiyoka) (utc . 1212711085) (rank . 3)) 
    … …  
    204228                               (8208 1) 
    205229                               (13317 6 5 4 3) 
    206                                (13304 2)))) 
     230                               (13304 2))) 
     231                    (plain "* " "----" "*** " "*** " "*** " "*** " "")) 
    207232                  (lambda () (serialize oldtype-page))) 
    208233