commit f9501847ff00925bfd14123607d88b81b24722a1
parent d717e2629dbd32e30a7faf7b9e45ed8a43d5f93b
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date: Sat, 5 Sep 2026 15:37:57 +0000
Basic page navigation buttons
Diffstat:
| M | src/cgi.scm | | | 41 | +++++++++++++++++++++++++++++++++++------ |
1 file changed, 35 insertions(+), 6 deletions(-)
diff --git a/src/cgi.scm b/src/cgi.scm
@@ -180,14 +180,18 @@ END-OF-CSS
(let ((val (input-var name)))
(if val val (bad-input (conc "missing " name)))))
+(define-constant default-n 100)
(define (q-limit-offset q)
(let* ((ns (alist-ref "n" q string=?))
(nn (if ns (string->number ns) #f))
- (n (if (and nn (positive? nn)) nn 100))
+ (n (if (and nn (positive? nn)) nn default-n))
(ps (alist-ref "p" q string=?))
(pn (if ps (string->number ps) #f))
(p (if (and pn (positive? pn)) pn 1)))
- (list n (* n (sub1 p)))))
+ (list (add1 n) (* n (sub1 p)))))
+(define (np-limit-offset l o)
+ (let ((n (sub1 l)))
+ (cons n (add1 (quotient o n)))))
(define start-html
"Content-Type: text/html\r\n\r\n<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">")
@@ -704,6 +708,34 @@ END-OF-CSS
WHERE entry.id=? GROUP BY entry.id;"))
(abs id))))
+(define (gruik-list-items row->fragment q args)
+ (let ((items (apply query (map-rows* row->fragment) (sql db q) args))
+ (np (if (or (null? args) (null? (cdr args)))
+ #f
+ (let loop ((a (car args)) (b (cadr args)) (rest (cddr args)))
+ (if (null? rest)
+ (np-limit-offset a b)
+ (loop b (car rest) (cdr rest)))))))
+ (if (and np (or (> (cdr np) 1) (> (length items) (car np))))
+ (let* ((n-part (if (= (car np) default-n) "" (conc "n=" (car np) "&")))
+ (nav `(form (@ (method "GET"))
+ ,@(if (> (cdr np) 1)
+ `((input (@ (type "submit") (class lsub)
+ (name "p") (value ,(sub1 (cdr np))))))
+ '())
+ (div (@ (class "form-body"))
+ ,@(if (= (car np) default-n)
+ '()
+ `((input (@ (type "hidden") (name "n")
+ (value ,(car np))))))
+ (p (@ (style "text-align: center"))
+ ,(conc "Page " (cdr np))))
+ ,@(if (> (length items) (car np))
+ `((input (@ (type "submit") (class rsub)
+ (name "p") (value ,(add1 (cdr np))))))
+ '()))))
+ (append (list nav) items (list nav)))
+ items)))
(define (gruik-list-view title row->fragment footer q . args)
(html-output
`(html
@@ -723,10 +755,7 @@ END-OF-CSS
(li (a (@ (href "./")) "Latest gruiks"))
(li (a (@ (href "deleted")) "Deleted gruiks"))
(li (a (@ (href "no-comm")) "Sourceless gruiks"))))
- ,@(apply query
- (map-rows* row->fragment)
- (sql db q)
- args)
+ ,@(gruik-list-items row->fragment q args)
,@footer))))
(define (new-fragment)
