From 3767aaebd67e6ec3179cfd4df88616e1385ec5c2 Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Mon, 27 Jun 2005 20:54:10 +0000
Subject: Updated

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@340 941c8c0f-9102-463b-b60b-cd22ce0e6858
---
 cgi-bin/nea.cgi.in | 131 +++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 93 insertions(+), 38 deletions(-)

(limited to 'cgi-bin/nea.cgi.in')

diff --git a/cgi-bin/nea.cgi.in b/cgi-bin/nea.cgi.in
index 86bbeb0..ca609ab 100644
--- a/cgi-bin/nea.cgi.in
+++ b/cgi-bin/nea.cgi.in
@@ -49,7 +49,7 @@
 
 (define (sql-error-handler err descr)
   (format #t "<h1 class=\"error\">~A</h1>\n"
-	  "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε.")
+	  (_ "ΣΦΆΛΜΑ: σύνδεση με την βάση δεδομένων απέτυχε."))
   (with-output-to-port
       (current-error-port)
     (lambda ()
@@ -63,60 +63,109 @@
 	  (lambda (key err descr)
 	    (sql-error-handler err descr))))
 
+(defmacro assert-article (expr)
+  `(if article
+       (if (null? article)
+	   (format #t "<h1 class=\"error\">~A</h1>\n"
+		   (_ "Κάμια καταχώρηση"))
+	   ,expr)))
+	   
 (define (summary)
   (catch-sql
    (let ((result (sql-query
 		  conn "SELECT date,header,ident FROM news ORDER BY date")))
      (cond
       ((null? result)
-       (display "<div align=\"center\">No news</div>"))
+       (display "<div align=\"center\">")
+       (display (_ "Κανένα νέα"))
+       (display "</div>"))
       (else
-       (display "<table class=\"newssummary\">\n")
-       (for-each
-	(lambda (entry)
-	  (display "<tr>\n")
-	  (display "<td class=\"date\">")
-	  (display (list-ref entry 0))
-	  (display "</td>")
-	  (display "<td class=\"subject\"><a href=\"")
-	  (display (make-cgi-name nea-cgi-path "id" (list-ref entry 2)))
-	  (display "\">")
-	  (display (list-ref entry 1))
-	  (display "</a></td>")
-	  (display "\n</tr>\n"))
-	result)
+       (display "<table class=\"news-summary\">\n")
+       (let ((ctr 0))
+	 (for-each
+	  (lambda (entry)
+	    (display "<tr class=\"")
+	    (display (if (= (modulo ctr 2) 0) "even" "odd"))
+	    (display "\">\n")
+	    (set! ctr (1+ ctr))
+	    (display "<td class=\"date\">")
+	    (display (list-ref entry 0))
+	    (display "</td>")
+	    (display "<td class=\"subject\"><a href=\"")
+	    (display (make-cgi-name nea-cgi-path "id" (list-ref entry 2)))
+	    (display "\">")
+	    (display (list-ref entry 1))
+	    (display "</a></td>")
+	    (display "\n</tr>\n"))
+	  result))
        (display "</table>"))))))
-  
+
+(define (display-article-header item)
+  (format #t "<span class=\"itemdate\">~A</span>\n" (car item))
+  (display "<span class=\"itemsubject\">\n")
+  (display (list-ref item 2))
+  (display "</span> "))
+
+(define (display-article-text item . rest)
+  (let ((class (and (not (null? rest)) (car rest))))
+    (cond
+     (class
+      (display "\n<div class=\"")
+      (display class)
+      (display "\">\n")
+      (display (list-ref item 3))
+      (display "</div>\n"))
+     (else
+      (display (list-ref item 3))))))
+
 (define (main)
   (catch-sql
-   (if article
-       (if (null? article)
-	   (format #t "<H1>No item found</H1>\n")
-	   (for-each
-	    (lambda (item)
-	      (format #t "<span class=\"itemdate\">~A</span>\n"
-		      (car item))
-	      (display "<span class=\"itemheader\">\n")
-	      (display (list-ref item 2))
-	      (display "</span> ")
-	      
-	      (if (not (cgi:value "timestamp"))
-		  (permalink "span" (list-ref item 1)))
-	      
-	      (display "<div class=\"itemtext\">")
-	      (display (list-ref item 3))
-	      (display "</div>"))
-	    article)))))
+   (assert-article
+    (for-each
+     (lambda (item)
+       (display-article-header item)
+       
+       (if (not (cgi:value "timestamp"))
+	   (permalink "span" (list-ref item 1)))
+       
+       (display-article-text item "itemtext"))
+     article))))
 
 (define (title)
   (if article
-      (display (if (null? article) "No item" (list-ref (car article) 2)))))
+      (display (if (null? article)
+		   (string-append
+		    "<h1 class=\"error\">"
+		    (_ "Κάμια καταχώρηση")
+		    "</h1>")
+		   (list-ref (car article) 2)))))
       
 
 (define (nea-html)
   (let ((explist (list (cons "@@main@@"     main)
 		       (cons "@@summary@@"  summary)
-		       (cons "@@title@@"    title))))
+		       (cons "@@title@@"    title)
+		       (cons "@@article-text@@"
+			     (lambda ()
+			       (catch-sql
+				(assert-article
+				 (display-article-text (car article))))))
+		       (cons "@@article-date@@"
+			     (lambda ()
+			       (catch-sql
+				(assert-article
+				 (display (caar article))))))
+		       (cons "@@article-header@@"
+			     (lambda ()
+			       (catch-sql
+				(assert-article
+				 (display (list-ref (car article) 2))))))
+		       (cons "@@full-header@@"
+			     (lambda ()
+			       (catch-sql
+				(assert-article
+				 (display-article-header
+				  (car article)))))))))
   
     (do ((line (read-line) (read-line)))
 	((eof-object? line) #f)
@@ -158,8 +207,14 @@
 		    (list (cons "@@main@@"
 				(lambda ()
 				  (sql-error-handler err descr)))
+			  (cons "@@article-text@@"
+				(lambda ()
+				  (sql-error-handler err descr)))
 			  (cons "@@summary@@"  (lambda () #f))
-			  (cons "@@title@@"    (lambda () #f)))))
+			  (cons "@@title@@"    (lambda () #f))
+			  (cons "@@article-date@@" (lambda () #f))
+			  (cons "@@article-header@@" (lambda () #f))
+			  (cons "@@full-header@@" (lambda () #f)))))
 	       (do ((line (read-line) (read-line)))
 		   ((eof-object? line) #f)	       
 		 (expand-template explist line)
-- 
cgit v1.2.1