Changeset 20996 in project


Ignore:
Timestamp:
10/24/10 21:26:55 (11 years ago)
Author:
sjamaan
Message:

sxml-fu: Convert pagination rules to starred forms and add a basic test (needs a lot more testing though)

Location:
release/4/sxml-fu/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/sxml-fu/trunk/sxml-pagination.scm

    r20046 r20996  
    11;;; sxml-pagination.scm
    22;
    3 ; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl)
     3; Copyright (c) 2004-2010 Peter Bex (Peter.Bex@xs4all.nl)
    44; All rights reserved.
    55;
     
    3030(module sxml-pagination
    3131  (page-var page-size base-uri determine-page page-count first-entry
    32    last-entry pagination-rules)
     32   last-entry pagination-rules pagination-rules*)
    3333
    3434(import chicken scheme extras data-structures)
    3535
    36 (require-extension sxml-transforms srfi-1 srfi-13 uri-common)
     36(require-extension sxml-transforms sxml-fu srfi-1 srfi-13 uri-common)
    3737
    3838;; Variable fetching and link generation should be done differently
     
    6767
    6868(define (expand-entries code entries size)
    69   (pre-post-order
     69  (pre-post-order*
    7070   code
    7171   `((entries . ,(lambda (tag code)
    7272                   (map (lambda (entry)
    73                           (pre-post-order
     73                          (pre-post-order*
    7474                           code
    75                            `((entry . ,(lambda (tag)
     75                           `((entry . ,(lambda (tag _)
    7676                                         (if (promise? entry)
    7777                                             (force entry)
    7878                                             entry)))
    79                              (*default* . ,(lambda code code))
     79                             (*default* . ,(lambda (tag code) (cons tag code)))
    8080                             (*text* . ,(lambda (text string) string)))))
    8181                        entries)))
    82      (pagination-links . ,(lambda (tag)
     82     (pagination-links . ,(lambda (tag _)
    8383                            `(pagination-info ,size)))
    84      (current-page . ,(lambda (tag)
     84     (current-page . ,(lambda (tag _)
    8585                        (determine-page size)))
    86      (page-count . ,(lambda (tag)
     86     (page-count . ,(lambda (tag _)
    8787                      (page-count size)))
    88      (last-entry . ,(lambda (tag)
     88     (last-entry . ,(lambda (tag _)
    8989                      (last-entry size)))
    90      (first-entry . ,(lambda (tag)
     90     (first-entry . ,(lambda (tag _)
    9191                       (first-entry size)))
    9292     (*text* . ,(lambda (text string) string))
    93      (*default* . ,(lambda code code)))))
     93     (*default* . ,(lambda (tag code) (cons tag code))))))
    9494
    9595;; This is a long mofo.  I don't really see a way to make it shorter, though
     
    128128                                                 (uri-query (base-uri))))))
    129129
    130 (define pagination-rules
     130(define pagination-rules*
    131131  `((paginate-list *macro* .
    132      ,(lambda (tag code entries)
    133         (let* ((size (length entries))
     132     ,(lambda (tag contents)
     133        (let* ((code (car contents))
     134               (entries (cadr contents))
     135               (size (length entries))
    134136               (start (first-entry size))
    135137               (end (last-entry size))
     
    139141          `(paginate ,code ,page-entries ,size))))
    140142    (paginate *macro* .
    141      ,(lambda (tag code entries size)
    142         (let* ((pages (page-count size)))
     143     ,(lambda (tag contents)
     144        (let* ((code (car contents))
     145               (entries (cadr contents))
     146               (size (caddr contents))
     147               (pages (page-count size)))
    143148          (expand-entries code entries size))))
    144149    (pagination-info *macro* .
    145      ,(lambda (tag size)
    146         (page-navigation size)))
     150     ,(lambda (tag contents)
     151        (page-navigation (car contents))))
    147152    (page-link *macro* .
    148      ,(lambda (tag pg txt . rest)
    149         `(a (@ (href ,(make-uri-string pg))) ,txt)))
    150     ,@alist-conv-rules))
     153     ,(lambda (tag contents)
     154        (let ((pg (car contents))
     155              (link-text (cadr contents)))
     156         `(a (@ (href ,(make-uri-string pg))) ,link-text))))
     157    . ,alist-conv-rules*))
     158
     159(define pagination-rules
     160  (starred->normal-transformation-rules pagination-rules*))
    151161)
  • release/4/sxml-fu/trunk/sxml-shortcuts.scm

    r20995 r20996  
    11;;; sxml-shortcuts.scm
    22;
    3 ; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl)
     3; Copyright (c) 2004-2010 Peter Bex (Peter.Bex@xs4all.nl)
    44; All rights reserved.
    55;
  • release/4/sxml-fu/trunk/tests/run.scm

    r20995 r20996  
    1 (use test sxml-transforms sxml-fu sxml-shortcuts)
     1(use test sxml-transforms sxml-fu sxml-shortcuts sxml-pagination)
    22
    33(define normal-rules
     
    6767                         shortcut-rules*)))
    6868
     69(test-group "pagination"
     70  (test "list pagination"
     71        '(ul (li "a") (li "b") (li "c") (li "d"))
     72        (pre-post-order-splice*
     73         '(paginate-list
     74           (ul (entries (li (entry))))
     75           ("a" "b" "c" "d")) pagination-rules*)))
     76
    6977(test-end "sxml-fu")
    7078
Note: See TracChangeset for help on using the changeset viewer.