Changeset 26876 in project


Ignore:
Timestamp:
06/11/12 20:43:18 (9 years ago)
Author:
sjamaan
Message:

qwiki: Add pager links to bottom of search results page

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/qwiki/trunk/qwiki-search.scm

    r26108 r26876  
    3939
    4040(import chicken scheme)
    41 (use data-structures extras srfi-1 srfi-13 intarweb uri-common
     41(use data-structures extras srfi-1 srfi-13 intarweb uri-common spiffy
    4242     qwiki qwiki-sxml sxml-transforms sxpath sxpath-lolevel estraier-client)
    4343(require-library regex)
     
    112112     . ,(lambda contents contents))
    113113    ,@alist-conv-rules*))
     114
     115(define (search-result-page text class p current-page page-count)
     116  (cond
     117   ((= p current-page)
     118    `(span (@ (class ,(sprintf "~A current-page" class))) ,text))
     119   ((or (< p 0) (>= p page-count))
     120    `(span (@ (class ,(sprintf "~A invalid-page" class))) ,text))
     121   (else
     122    (let* ((uri (request-uri (current-request)))
     123           (q (uri-query uri))
     124           (q (alist-update! 'page p q))
     125           (uri (update-uri uri query: q)))
     126      `(a (@ (href ,(uri->string uri))
     127             (class ,class)
     128             (title ,(sprintf "View page ~A of ~A" (add1 p) page-count)))
     129          ,text)))))
    114130
    115131(define (search request)
     
    143159                      max: page-size
    144160                      skip: (* page page-size))
    145       (send-content
    146        `(wiki-page
    147          (Header (title ,(sprintf "Search results for \"~A\"" phrase))
    148                  . ,(if (qwiki-css-file)
    149                         `((style ,(uri->string
    150                                    (uri-relative-to (qwiki-css-file)
    151                                                     (qwiki-base-uri)))))
    152                         '()))
    153          (body
    154           (div (@ (id "search-results"))
    155                (h1 ,(sprintf "Search results for \"~A\"" phrase))
    156                ,(if (null? docs)
    157                     `(p (@ (id "no-results-message"))
    158                         "I'm terribly sorry, but I could not find anything "
    159                         "to match your query. Please try a different query.")
    160                     `(dl (@ (id "result-list"))
    161                          . ,(map
    162                              (lambda (doc)
    163                                (let* ((matches (car doc))
    164                                       (uri (alist-ref '@uri (cdr doc)))
    165                                       (title (alist-ref '@title (cdr doc) eq? uri)))
    166                                  `((dt (a (@ (href ,uri)) ,title))
    167                                    (dd ,@(fold-right
    168                                           (lambda (match info)
    169                                             (cond
    170                                              ((car match)
    171                                               `(#t ((em ,(car match))
    172                                                     . ,(cadr info))))
    173                                              ((car info) ;; Still same snippet?
    174                                               `(#f (,(cdr match)
    175                                                     . ,(cadr info))))
    176                                              (else
    177                                               `(#f (,(cdr match) " ... "
    178                                                     . ,(cadr info))))))
    179                                           '(#f ())
    180                                           matches)))))
    181                              docs))))))))))
     161      (let* ((hit (alist-ref 'HIT meta))
     162             (num-results (or (and hit (pair? hit) (string->number (car hit))) 0))
     163             (num-pages (floor (/ num-results page-size))))
     164       (send-content
     165        `(wiki-page
     166          (Header (title ,(sprintf "Search results for \"~A\"" phrase))
     167                  . ,(if (qwiki-css-file)
     168                         `((style ,(uri->string
     169                                    (uri-relative-to (qwiki-css-file)
     170                                                     (qwiki-base-uri)))))
     171                         '()))
     172          (body
     173           (div (@ (id "search-results"))
     174                (h1 ,(sprintf "Search results for \"~A\"" phrase))
     175                ,(if (null? docs)
     176                     `(p (@ (id "no-results-message"))
     177                         "I'm terribly sorry, but I could not find anything "
     178                         "to match your query. Please try a different query.")
     179                     `(div (dl (@ (id "result-list"))
     180                               . ,(map
     181                                   (lambda (doc)
     182                                     (let* ((matches (car doc))
     183                                            (uri (alist-ref '@uri (cdr doc)))
     184                                            (title (alist-ref '@title (cdr doc) eq? uri)))
     185                                       `((dt (a (@ (href ,uri)) ,title))
     186                                         (dd ,@(fold-right
     187                                                (lambda (match info)
     188                                                  (cond
     189                                                   ((car match)
     190                                                    `(#t ((em ,(car match))
     191                                                          . ,(cadr info))))
     192                                                   ((car info) ;; Still same snippet?
     193                                                    `(#f (,(cdr match)
     194                                                          . ,(cadr info))))
     195                                                   (else
     196                                                    `(#f (,(cdr match) " ... "
     197                                                          . ,(cadr info))))))
     198                                                '(#f ())
     199                                                matches)))))
     200                                   docs))
     201                           (ul (@ (class "pager"))
     202                               ,(search-result-page
     203                                 "Previous" "prev-page" (sub1 page)
     204                                 page num-pages)
     205                               ,@(list-tabulate
     206                                  num-pages
     207                                  (lambda (p)
     208                                    (search-result-page
     209                                     (->string (add1 p)) "page-nr" p
     210                                     page num-pages)))
     211                               ,(search-result-page
     212                                 "Next" "next-page" (add1 page)
     213                                 page num-pages))))))))))))
    182214
    183215(define (search-install!)
Note: See TracChangeset for help on using the changeset viewer.