From 37c0380e357a7b31c95710d018c83b4444441cf8 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Fri, 24 Mar 2006 22:56:46 +0000 Subject: Implement scrolling of news lists. git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@413 941c8c0f-9102-463b-b60b-cd22ce0e6858 --- cgi-bin/nea.cgi.in | 217 +++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 170 insertions(+), 47 deletions(-) diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in index 5805097..8c625e5 100644 --- a/cgi-bin/nea.cgi.in +++ b/cgi-bin/nea.cgi.in @@ -49,6 +49,7 @@ s))) (string-split (getenv "HTTP_ACCEPT_LANGUAGE") #\,))) +(define nea-max-rows 20) ;; FIXME: Move to the config (define (permalink tag timestamp) (display (string-append "<" tag " class=\"permalink\">")) @@ -115,46 +116,165 @@ (map language-code (cons target-language accepted-lang))) + +(define (collect-entries from fwd) + (let loop ((start from) + (result '())) + (cond + ((not fwd) + (set! start (- start nea-max-rows)) + (if (< start 0) + (set! start 0)))) + (call-with-current-continuation + (lambda (return) + (let ((tuples (sql-query + conn + (format #f + "SELECT date,ident FROM news ORDER BY 1 DESC LIMIT ~A,~A" + start nea-max-rows)))) + (cond + ((null? tuples) + (cons start (if fwd (reverse result) result))) + (else + (let ((langlist (make-my-lang-list)) + (rest (- nea-max-rows (length result))) + (ctr 0)) + (for-each + (lambda (entry) + (let ((lang (get-sql-lang conn (list-ref entry 1) langlist))) + (set! ctr (1+ ctr)) + (if lang + (let ((hdr (sql-query conn + (string-append + "SELECT header,lang " + "FROM newsart " + "WHERE ident=" (list-ref entry 1) " " + "AND lang='" lang "' " + "LIMIT 1")))) + (cond + (hdr + (set! result (cons + (cons (caar hdr) entry) + result)) + (set! rest (1- rest)) + (cond + ((= 0 rest) + (if fwd + (return (cons (+ ctr start) (reverse result))) + (return (cons (+ start (- nea-max-rows ctr)) + result))))))))))) + + (if fwd + tuples + (reverse tuples))) + + (cond + ((and (not fwd) (= 0 start)) + (cons start (if fwd (reverse result) result))) + (else + (if fwd + (set! start (+ ctr start))) + (loop start result))))))))))) + (define (summary) (catch-sql - (let ((result (sql-query - conn "SELECT date,ident FROM news ORDER BY 1 DESC"))) - (cond - ((null? result) - (display "
") - (display (_ "Κανένα νέα")) - (display "
")) - (else - (display "\n") - (let ((ctr 0) - (langlist (make-my-lang-list))) - (for-each - (lambda (entry) - (let* ((lang (get-sql-lang conn (list-ref entry 1) langlist)) - (hdr (sql-query conn - (string-append - "SELECT header,lang " - "FROM newsart " - "WHERE ident=" (list-ref entry 1) " " - "AND lang='" lang "' " - "LIMIT 1")))) - (cond - (hdr + (let* ((count (catch #t + (lambda () + (string->number + (caar (sql-query conn "SELECT count(*) FROM news")))) + (lambda args + 0))) + (from (catch #t + (lambda () + (let ((x (string->number (cgi:value "from")))) + (if (< x count) + x + 0))) + (lambda args + 0))) + (fwd (let ((dir (cgi:value "dir"))) + (or (not dir) + (string=? dir "1")))) + (entries (collect-entries from fwd))) + + (let ((start (car entries)) + (result (cdr entries))) + (cond + ((null? result) + (display "
") + (display (_ "Κανένα νέα")) + (display "
")) + (else + (let ((num-entries (length result)) + (begin (if fwd from start)) + (end (if fwd start from)) + (id (cgi:value "id"))) + + (cond + ((not (and (= from 0) (< num-entries nea-max-rows))) + (display "

") + (format #t (_ "Εγγραφείς ~A - ~A") begin end) + (display "

"))) + + (display "
\n") + (let ((ctr 0) + (langlist (make-my-lang-list))) + (for-each + (lambda (entry) (display "\n") (set! ctr (1+ ctr)) (display "") + (display "") - (display "") - (display "\n\n"))))) - result)) - (display "
") - (display (list-ref entry 0)) + (display (list-ref entry 1)) + (display "") + (display (list-ref entry 0))) + (else + (display "\">string begin))) + (display "\">") + (display (list-ref entry 0)) + (display ""))) (display "") - (display (list-ref (car hdr) 0)) - (display "
")))))) + (display "\n\n")) + result)) + (display "") + + (display "
") + (cond + ((> begin 0) + (display "string begin) + "dir" "0" + (if id + (list "id" id) + '()))) + (display "\">") + (display (_ "Προηγούμενες")) + (display ""))) + + (cond + ((< end count) + (display "string end) + "dir" "1" + (if id + (list "id" id) + '()))) + (display "\">") + (display (_ "Ερχόμενες")) + (display ""))) + (display "
")))))))) (define (display-article-header item) (format #t "~A\n" (car item)) @@ -359,21 +479,24 @@ ((cgi:value "id") => (lambda (id) (string-append "ident=" id)))))))) - (let* ((res (car tuples)) - (lang (get-sql-lang conn - (list-ref res 2) (make-my-lang-list))) - (art (sql-query - conn - (string-append - "SELECT header,text,lang " - "FROM newsart " - "WHERE ident=" (list-ref res 2) " " - "AND lang='" lang "' " - "LIMIT 1")))) - (set! article (append - (list (list-ref res 0) - (list-ref res 1)) - (car art))))))) + + (if (not (null? tuples)) + (let* ((res (car tuples)) + (lang (get-sql-lang conn + (list-ref res 2) + (make-my-lang-list))) + (art (sql-query + conn + (string-append + "SELECT header,text,lang " + "FROM newsart " + "WHERE ident=" (list-ref res 2) " " + "AND lang='" lang "' " + "LIMIT 1")))) + (set! article (append + (list (list-ref res 0) + (list-ref res 1)) + (car art)))))))) (with-input-from-file (template-file target-language tmpl) -- cgit v1.2.1