*** empty log message ***

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@460 941c8c0f-9102-463b-b60b-cd22ce0e6858

3 files changed, 1185 insertions, 13 deletions

diff --git a/cgi-bin/dict.scm4 b/cgi-bin/dict.scm4
new file mode 100644
index 0000000..ab445d4
--- a/dev/null
+++ b/cgi-bin/dict.scm4
@@ -0,0 +1,621 @@
+;;;; Greek Dictionary Web Engine
+;;;; Copyright (C) 2004, 2005, 2006 Sergey Poznyakoff
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;;
+
+;;; Tailor this statement to your needs if necessary.
+(set! %load-path (cons "GUILE_SITE" %load-path))
+
+(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
+             (ice-9 rdelim)
+             (gamma sql)
+             (gamma gettext)
+             (xmltools dict)
+             (ellinika xlat)
+             (ellinika cgi))
+
+ifelse(IFACE,[CGI],(cgi:init))
+
+(ellinika-cgi-init dict-template-file-name)
+
+;; Τα μέρη του λογου
+(define part-of-speech '())
+
+(define (sql-error-handler err descr)
+  (format #t "<h1 class=\"error\">~A</h1>\n"
+          (_ "ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))
+  (with-output-to-port
+      (current-error-port)
+    (lambda ()
+      (display err)
+      (display ": ")
+      (display descr))))  
+
+(define (mk-dict-connect)
+  (let ((db-connection #f))
+    (lambda (. rest)
+      (cond
+       ((null? rest)
+        (if (not db-connection)
+            (begin
+              (set! db-connection
+                    (sql-connect
+                     sql-iface sql-host sql-port sql-database
+                     sql-username sql-password))
+              (sql-query db-connection "SET NAMES utf8")
+              )))
+       (else
+        (if db-connection
+            (sql-connect-close db-connection))
+        (set! db-connection #f)))
+      db-connection)))
+
+(define dict-connect (mk-dict-connect))
+
+(defmacro catch-sql-failure (expr)
+  `(catch 'gsql-error
+          (lambda () ,expr)
+          (lambda (key err descr)
+            (sql-error-handler err descr))))
+
+(defmacro ignore-sql-failure (expr)
+  `(catch 'gsql-error
+          (lambda () ,expr)
+          (lambda (key err descr)
+            #f)))
+
+(define (load-pos)
+  (ignore-sql-failure
+   (let ((conn (dict-connect)))
+     (let ((plist (my-sql-query
+                   conn
+                   "SELECT name,id FROM pos WHERE canonical='Y' order by id")))
+       (set! part-of-speech
+             (cons
+              (cons "κανένα μέρος του λόγου" #f)
+              (map
+               (lambda (x)
+                 (cons (car x) (cadr x)))
+               plist)))))))
+
+;; Protect occurences of " in a string.
+;; Usual backslash escapes do not work in INPUT widgets, so I
+;; change all quotation marks to &#34;
+;; Possibly not the better solution, though...
+(define (protect string)
+  (list->string
+   (apply append
+          (map
+           (lambda (x)
+             (if (eq? x #\")
+                 (list #\& #\# #\3 #\4 #\;)
+                 (list x)))
+           (string->list string)))))
+
+(define (get-topic-list)
+  (let ((categories #f))
+    (letrec ((getcat
+              (lambda ()
+                (ignore-sql-failure
+                 (let ((conn (dict-connect)))
+                   (let ((ctg (my-sql-query
+                               conn
+                               (string-append
+                                "SELECT t.category, c.title, c.description "
+                                "FROM category c,topic t "
+                                "WHERE c.lang='" (language-code target-language) "' "
+                                "AND c.category=t.category GROUP BY 1 ORDER BY 1"))))
+                     (if (null? ctg)
+                         '()
+                         (map
+                          (lambda (category)
+                            (let ((topics (my-sql-query
+                                           conn
+                                           (string-append 
+                                            "SELECT ident,title FROM topic WHERE category="
+                                            (car category)
+                                            " ORDER BY title"))))
+                              (append category (if (null? topics)
+                                                   '()
+                                                   (list topics)))))
+                          ctg))))))))
+      (if (not categories)
+          (set! categories (or (getcat) '())))
+      categories)))
+
+(define (join-widget widget-id tabindex)
+  (let* ((name (string-append "join" widget-id))
+         (selected-choice (or (let ((s (cgi:value name)))
+                                (if s
+                                    (string->number s)
+                                    #f))
+                              0)))
+    (display (string-append "<SELECT NAME=\""
+                            name
+                            "\" TABINDEX=\""
+                            tabindex
+                            "\">"))
+    (display "<OPTION VALUE=\"0\"")
+    (if (= selected-choice 0)
+        (display " selected"))
+    (display ">") (display (_"και")) (display "</OPTION>")
+    (display "<OPTION VALUE=\"1\"")
+    (if (= selected-choice 1)
+        (display " selected"))
+    (display ">") (display (_"ή")) (display "</OPTION>")
+    (display "</SELECT>")))
+
+(define (main-form)
+  (load-pos)
+  (display "<FORM ACTION=\"")
+  (display (make-cgi-name cgi-script-name))
+  (display "\" METHOD=POST>
+<table class=\"noframe\">
+<tr>
+ <td>")
+  (display (_"Εισάγετε τη λέξη"))
+  (display "
+ </td>
+ <td>
+  <input size=\"36\" name=\"key\" tabindex=\"1\"")
+  (let ((value (cgi:value "key")))
+    (if value
+        (begin
+          (display "value=\"")
+          (display (protect value))
+          (display "\""))))
+  (display ">
+ </td>
+</tr>")
+
+  (display "<tr><td colspan=\"3\" align=\"center\">")
+  (display (_"Συμπληρωματικοί όροι"))
+  (display "</td></tr>")
+
+  (display "
+<tr>
+ <td>")
+  (display (_"Επιλέξτε το μέρος του λόγου"))
+  (display "</td><td>")
+  
+  (let ((selected-choice (or (let ((s (cgi:value "POS")))
+                               (if s
+                                   (string->number s)
+                                   #f))
+                             0))
+        (index 0))
+    
+    (display "<select name=\"POS\" tabindex=\"2\">")
+    
+    (for-each
+     (lambda (x)
+       (let ((name (car x)))
+         (display "<option value=")
+         (display index)
+         (if (= index selected-choice)
+             (display " selected"))
+         (display ">")
+         (display name)
+         (set! index (1+ index))))
+     part-of-speech)
+    (display "</select>"))  
+
+  (display "</td><td>")
+  (join-widget "pos" "3")
+  (display "</td></tr>")
+
+  (let ((tabindex 4))
+    (for-each
+     (lambda (category)
+       (display "<tr><td>")
+       (display (list-ref category 1))
+       (display "</td><td>")
+       (let ((selected-choice (or (let ((s (cgi:value (list-ref category 0))))
+                                    (if s
+                                        (string->number s)
+                                        #f))
+                                  0)))
+
+         (display (string-append
+                   "<select name=\""
+                   (list-ref category 0)
+                   "\" tabindex=\""
+                   (number->string tabindex)
+                   "\">"))
+         (set! tabindex (1+ tabindex))
+         (display "<option value=0>---")
+         (for-each
+          (lambda (x)
+            (let ((id (car x))
+                  (name (car (cdr x))))
+              (display "<option value=")
+              (display id)
+              (if (eq? (string->number id) selected-choice)
+                  (display " selected"))
+              (display ">")
+              (display name)
+              (display "</option>")))
+          (list-ref category 3))
+         (display "</select>")
+         (display "</td><td>")
+         (join-widget (list-ref category 0) (number->string tabindex))
+         (display "</td></tr>")
+         (set! tabindex (1+ tabindex))))
+     (get-topic-list))
+  
+    (display "
+<tr>
+ <td colspan=\"3\" align=\"center\">
+  <input type=\"submit\" name=\"search\" value=\"")
+    (display (_"Αναζήτηση"))
+    (display "\" tabindex=\"")
+    (display tabindex)
+    (display "\">
+ </td>
+</tr>
+</table>
+</form>
+<p>")))
+
+;;
+(define (replace-tilde word sentence)
+  (apply
+   string-append
+   (let loop ((lst '())
+              (str sentence))
+     (cond
+      ((string-index str #\~) =>
+       (lambda (x)
+         (loop
+          (append lst (list (substring str 0 x) word))
+          (substring str (1+ x)))))
+      ((string-null? str)
+       lst)
+      (else
+       (append lst (list str)))))))
+
+;;
+(define (display-results rlist)
+  (let ((x (car rlist)))
+    (display "<table class=\"noframe\">")
+    (display "<tr><td>")
+    (display (car x))
+    (display "</td>")
+    (cond
+     ((list-ref x 3)
+      (display "<td>")
+      (let ((href (assoc (list-ref x 2) word-forms-reference)))
+        (cond
+         (href
+          (display "<a href=\"")
+          (cond
+           (ref-loc
+            (display ref-loc)
+            (display "/")))
+          (display (language-code target-language))
+          (display "/")
+          (display (cdr href))
+          (display (dict:encode-string (car x)))
+          (display "\">")
+          (display (list-ref x 3))
+          (display "</a>"))
+         (else
+          (display (list-ref x 3)))))
+      (display "</td>")))
+    (display "<td>")
+    (display (list-ref x 2))
+    (display "</td></tr>"))
+  (for-each
+   (lambda (x)
+     (display "<tr><td>")
+     (display (1+ (string->number (list-ref x 4))))
+     (display "</td><td>")
+     (display (replace-tilde (car x) (list-ref x 5)))
+     (display ";</td></tr>"))
+   rlist)
+  (display "</table>")
+  (newline))
+
+(define (display-cross-reference word)
+  (display "<a href=\"")
+  (display (make-cgi-name cgi-script-name "IDENT" (dict:encode-string word)))
+  (display "\">")
+  (display word)
+  (display "</a>"))
+
+(define (display-xref rlist text)
+  (display text)
+  (let ((n 0))
+    (for-each
+     (lambda (x)
+       (if (> n 0)
+           (display ", "))
+       (set! n (1+ n))
+       (display-cross-reference (car x)))
+     rlist))
+  (display ";"))
+
+(define (sort-result input-list)
+  (let ((output-list '())
+        (current-element '()))
+    (for-each
+     (lambda (x)
+       (cond
+        ((or (null? current-element)
+             (=  (string->number (cadr x))
+                 (string->number (cadr (car current-element)))))
+         (set! current-element (cons x current-element)))
+        (else
+         (set! output-list (cons (reverse current-element) output-list))
+         (set! current-element (list x)))))
+     input-list)
+    (cons (reverse current-element) output-list)))
+
+
+(define (search-failure key)
+  (display "<h2>")
+  (format #t (_"Συγγνώμη, η λέξη \"~A\" δεν βρέθηκε στο λέξικο.") key)
+  (display "</h2>"))
+
+(define (my-sql-query conn query)
+  (catch #t
+         (lambda ()
+           (sql-query conn query))
+         (lambda args
+           '())))
+
+(define (fuzzy-search conn key theme pos)
+  (let ((where-cond (list (string-append
+                           "WHERE dict.ident=articles.ident and articles.lang='"
+                           (language-code target-language)
+                           "' AND")))
+        (select-stmt "SELECT DISTINCT dict.word FROM ")
+        (from-list (list ",articles" "dict")))
+
+    (cond
+     ((not (null? theme))
+      (set! where-cond (cons " topic_tab.word_ident=dict.ident"
+                             where-cond))
+      (set! from-list (cons ",topic_tab" from-list))))
+
+    (cond
+     ((not (string-null? key))
+      (if (not (null? theme))
+          (set! where-cond (cons " AND" where-cond)))
+      (set! where-cond (cons (string-append
+                              " dict.sound LIKE \""
+                              (ellinika:sounds-like key)
+                              "%\"")
+                             where-cond))))
+
+    (cond
+     ((> (string->number pos) 0)
+      (let ((pos-entry
+             (list-ref part-of-speech (string->number pos))))
+        (if (or (not (string-null? key)) (not (null? theme)))
+            (set! where-cond (cons 
+                              (if (string=? (cgi:value "joinpos") "0")
+                                  " AND"
+                                  " OR")
+                              where-cond)))
+
+        (set! where-cond (cons
+                          (string-append " (dict.pos & "
+                                         (cdr pos-entry)
+                                         ") = "
+                                         (cdr pos-entry))
+                          where-cond)))))
+
+    (let ((result
+           (my-sql-query conn
+                         (string-append
+                          select-stmt
+                              
+                              " "
+                              
+                              (apply
+                               string-append
+                               (reverse from-list))
+
+                              " "
+                              
+                              (apply
+                               string-append
+                               (append
+                                (reverse where-cond)
+                                (map
+                                 (lambda (x)
+                                   (cond
+                                    ((boolean? x)
+                                     (if x " AND" " OR"))
+                                    (else
+                                     (if (not (member ",topic_tab" from-list))
+                                         (set! from-list
+                                               (cons ",topic_tab"
+                                                     from-list)))
+                                     (string-append
+                                      " topic_tab.topic_ident=" x))))
+                                 theme)))
+                              
+                              " ORDER BY dict.word"))))
+      
+      (cond
+       ((null? result)
+        (search-failure key))
+       (else
+        (display "<table width=\"100%\" class=\"noframe\">")
+        (let* ((result-length (length result))
+               (lim (1+ (inexact->exact (/ result-length match-list-columns)))))
+          (do ((i 0 (1+ i)))
+              ((= i lim) #f)
+                    (display "<tr>")  
+            (do ((j i (+ j lim)))
+                ((>= j result-length) #f)
+              (display "<td>")
+              (display-cross-reference (car (list-ref result j)))
+              (display "</td>"))
+                    (display "</tr>")))  
+        (display "</table>"))))))
+  
+
+(define (dict-search)
+  (let ((keyval (if (cgi:value "IDENT")
+                    (dict:decode-string (cgi:value "IDENT"))
+                    (cgi:value "key")))
+        (theme (do ((catlist (get-topic-list) (cdr catlist))
+                    (ret '()))
+                   ((null? catlist) ret)
+                 (let ((name (caar catlist)))
+                   (let ((v (cgi:value name)))
+                     (if (and v (> (string->number v) 0))
+                         (set! ret (append
+                                    ret
+                                    (list (= (string->number
+                                              (cgi:value (string-append "join" name))) 0)
+                                          v))))))))
+        (pos (or (cgi:value "POS") "0")))
+
+    (catch-sql-failure
+     (let ((conn (dict-connect)))
+       (cond
+        ((and keyval
+              (not (string-null? keyval))
+              (null? theme)
+              (= (string->number pos) 0))
+         (display "<hr>")
+         (let* ((key (ellinika:translate-input keyval))
+                (result (my-sql-query
+                         conn
+                         (string-append
+                          "SELECT dict.word,dict.ident,pos.abbr,dict.forms,articles.subindex,articles.meaning "
+                          "FROM dict,articles,pos WHERE dict.word=\""
+                          key
+                          "\" AND dict.ident=articles.ident "
+                          "AND articles.lang='" (language-code target-language) "' "
+                          "AND dict.pos=pos.id AND pos.canonical='Y' order by dict.ident, articles.subindex"))))
+           
+           (cond
+            ((null? result)
+             (fuzzy-search conn key theme pos))
+            (else
+             (for-each
+              (lambda (entry)
+                (display-results entry)
+                (let ((ant (my-sql-query
+                            conn
+                            (string-append
+                             "SELECT dict.word FROM dict,links WHERE links.type='ANT' AND links.ident="
+                             (cadr (car entry))
+                             " AND dict.ident=links.xref ORDER BY word"))))
+                  (if (and ant (not (null? ant)))
+                      (display-xref ant
+                                    (if (= (length ant) 1)
+                                        (_"Αντώνυμο: ") (_"Αντώνυμα: ")))))
+                (display "<p>")
+                (let ((x (my-sql-query
+                          conn
+                          (string-append
+                           "SELECT dict.word FROM dict,links WHERE links.type='XREF' AND links.ident="
+                           (cadr (car entry))
+                           " AND dict.ident=links.xref ORDER BY word"))))
+                  (if (and x (not (null? x)))
+                      (display-xref x (_"Βλέπετε επίσης ")))))
+              (sort-result result))))))
+        ((or (not (null? theme)) (> (string->number pos) 0))
+         (display "<hr>")
+         (fuzzy-search conn
+                       (ellinika:translate-input (or keyval "")) theme pos)))))))
+
+;;;
+
+(define (stat key)
+  (let ((stat-data #f))
+    (if (not stat-data)
+        (set! stat-data
+              (or
+               (ignore-sql-failure
+                (my-sql-query (dict-connect)
+                              (string-append
+                               "SELECT count,updated from stat WHERE lang='"
+                               (language-code target-language)
+                               "'")))
+               '())))
+    
+    (if (null? stat-data)
+        "<>"
+        (case key
+          ((#:updated)
+           (list-ref (car stat-data) 1))
+          ((#:count)
+           (list-ref (car stat-data) 0))
+          (else
+           "<>")))))
+  
+
+;;;
+
+(define (dict-html)
+  (let ((explist (list
+                  (cons "@@args@@"
+                        (lambda ()
+                          (for-each
+                           (lambda (name)
+                             (cond
+                              ((string=? name "LANG"))
+                              (else
+                               (let ((v (cgi:value name)))
+                                 (cond ((and v (not (string-null? v)))
+                                        (display "&amp;")
+                                        (display name)
+                                        (display "=")
+                                        (display v)))))))
+                           (cgi:names))))
+                  (cons "@@dict@@"
+                        (lambda ()
+                          (main-form)
+                          (dict-search)))
+                  (cons "@@stat_updated@@"
+                        (lambda ()
+                          (display (stat #:updated))))
+                  (cons "@@stat_count@@"
+                        (lambda ()
+                          (display
+                           (let ((s (stat #:count)))
+                             (if (string=? s "<>")
+                                 s
+                                 (let ((n (string->number s)))
+                                   (string-append s " "
+                                                  (ngettext "λέξη" "λέξεις"
+                                                            n)))))))))))
+    (do ((line (read-line) (read-line)))
+        ((eof-object? line) #f)
+      (expand-template explist line)
+      (newline))))
+  
+;;; Main
+ifelse(IFACE,[CGI],(display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
+
+(with-input-from-file
+    (template-file target-language dict-template-file-name)
+  dict-html)
+
+(dict-connect #t)
+
+;;;; Local variables:
+;;;; mode: Scheme
+;;;; buffer-file-coding-system: utf-8
+;;;; End:
+
diff --git a/cgi-bin/nea.scm4 b/cgi-bin/nea.scm4
new file mode 100644
index 0000000..20e1803
--- a/dev/null
+++ b/cgi-bin/nea.scm4
@@ -0,0 +1,536 @@
+;;;; News page for Ellinika
+;;;; Copyright (C) 2004, 2005, 2006 Sergey Poznyakoff
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;;
+
+;;; Tailor this statement to your needs if necessary.
+(set! %load-path (cons "GUILE_SITE" %load-path))
+
+(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
+             (gamma sql)
+             (gamma gettext)
+             (xmltools dict)
+             (ellinika xlat)
+             (ellinika cgi))
+
+ifelse(IFACE,[CGI],(cgi:init))
+
+(define tmpl (if (and monima-nea-template-file-name
+                      (cgi:value "timestamp"))
+                 monima-nea-template-file-name
+                 nea-template-file-name))
+
+(ellinika-cgi-init tmpl)
+
+(define conn #f)
+(define article #f)
+(define accepted-lang (map
+                       (lambda (s)
+                         (cond
+                          ((string-split s #\;) =>
+                           (lambda (l)
+                             (car l)))
+                          (else
+                           s)))
+                       (string-split (or
+                                      (getenv "HTTP_ACCEPT_LANGUAGE")
+                                      "")
+                                     #\,)))
+
+(define nea-max-rows 20) ;; FIXME: Move to the config
+
+(define (permalink tag timestamp)
+  (display (string-append "<" tag " class=\"permalink\">"))
+  (display "<a href=\"")
+  (display (make-cgi-name cgi-script-name "timestamp" timestamp))
+  (display "\">[permanent link]</a>")
+  (display (string-append "</" tag ">")))
+
+(define (sql-error-handler err descr)
+  (format #t "<h1 class=\"error\">~A</h1>\n"
+          (_ "ΣΦΆΛΜΑ: σύνδεση με την βάση δεδομένων απέτυχε."))
+  (with-output-to-port
+      (current-error-port)
+    (lambda ()
+      (display err)
+      (display ": ")
+      (display descr))))  
+
+(defmacro catch-sql (expr)
+  `(catch 'gsql-error
+          (lambda () ,expr)
+          (lambda (key err descr)
+            (sql-error-handler err descr))))
+
+(defmacro assert-article (. expr)
+  `(if article
+       (cond
+        ((null? article)
+         (format #t "<h1 class=\"error\">~A</h1>\n"
+                 (_ "Κάμια καταχώρηση")))
+        (else
+         ,@expr))))
+
+(define (make-sql-list input-list)
+  (let loop ((str "")
+             (input-list input-list))
+    (if (null? input-list)
+        (string-append "(" str ")")
+        (loop (string-append str
+                             (if (string-null? str) "'" ",'")
+                             (car input-list) "'")
+              (cdr input-list)))))
+
+(define (get-sql-lang conn ident langlist)
+  (let ((res (map car (sql-query conn
+                                 (string-append
+                                  "SELECT lang "
+                                  "FROM newsart "
+                                  "WHERE ident=" ident " "
+                                  "AND lang in " (make-sql-list langlist))))))
+    (cond
+     ((null? res)
+      #f)
+     (else
+      (call-with-current-continuation
+       (lambda (return)
+         (for-each
+          (lambda (elt)
+            (if (member elt res)
+                (return elt)))
+          langlist)))))))
+
+(define (make-my-lang-list)
+  (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* ((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 "<div align=\"center\">")
+         (display (_ "Κανένα νέα"))
+         (display "</div>"))
+        (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 "<p>")
+             (format #t (_ "Εγγραφείς ~A - ~A") begin end)
+             (display "</p>")))
+           
+           (display "<table class=\"news-summary frame\">\n")
+           (let ((ctr 0)
+                 (langlist (make-my-lang-list)))
+             (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 1))
+                (display "</td>")
+                (display "<td class=\"subject")
+                (cond
+                 ((and id (string=? (list-ref entry 2) id))
+                  (display " current\">")
+                  (display (list-ref entry 0)))
+                 (else
+                  (display "\"><a href=\"")
+                  (display (make-cgi-name cgi-script-name
+                                          "id" (list-ref entry 2)
+                                          "from" (number->string begin)))
+                  (display "\">")
+                  (display (list-ref entry 0))
+                  (display "</a>")))
+                (display "</td>")
+                (display "\n</tr>\n"))
+              result))
+           (display "</table>")
+
+           (display "<div class=\"menu-bar\" align=\"center\">")
+           (cond
+            ((> begin 0)
+             (display "<span class=\"menu-cell\"><a href=\"")
+             (display (apply make-cgi-name
+                             cgi-script-name
+                             "from" (number->string begin)
+                             "dir" "0"
+                             (if id
+                                 (list "id" id)
+                                 '())))
+             (display "\">")
+             (display (_ "Προηγούμενες"))
+             (display "</a></span>")))
+
+           (cond
+            ((< end count)
+             (display "<span class=\"menu-cell\"><a href=\"")
+             (display (apply make-cgi-name
+                             cgi-script-name
+                             "from" (number->string end)
+                             "dir" "1"
+                             (if id
+                                 (list "id" id)
+                                 '())))
+             (display "\">")
+             (display (_ "Ερχόμενες"))
+             (display "</a></span>")))
+           (display "</div>"))))))))
+
+(define (display-article-header item)
+  (display "<div id=\"news-header\">")
+  (format #t "<span class=\"itemdate\">~A</span>\n" (car item))
+  (display "<span class=\"itemsubject\">\n")
+  (display (list-ref item 2))
+  (display "</span>")
+  (if (not (cgi:value "timestamp"))
+      (permalink "span" (list-ref item 1)))
+  (display "</div><!-- news-header -->"))
+
+(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
+   (assert-article
+    (display-article-header article)
+    (display-article-text article "itemtext"))))
+
+(define (title)
+  (if article
+      (display (if (null? article)
+                   (string-append
+                    "<h1 class=\"error\">"
+                    (_ "Κάμια καταχώρηση")
+                    "</h1>")
+                   (list-ref article 2)))))
+      
+
+(define (nea-html)
+  (let ((explist (list (cons "@@main@@"     main)
+                       (cons "@@summary@@"  summary)
+                       (cons "@@title@@"    title)
+                       (cons "@@article-text@@"
+                             (lambda ()
+                               (catch-sql
+                                (assert-article
+                                 (display-article-text article)))))
+                       (cons "@@article-date@@"
+                             (lambda ()
+                               (catch-sql
+                                (assert-article
+                                 (display (car article))))))
+                       (cons "@@article-header@@"
+                             (lambda ()
+                               (catch-sql
+                                (assert-article
+                                 (display (list-ref article 2))))))
+                       (cons "@@full-header@@"
+                             (lambda ()
+                               (catch-sql
+                                (assert-article
+                                 (display-article-header
+                                  article)))))
+                       (cons "@@args@@"
+                             (lambda ()
+                               (for-each
+                                (lambda (name)
+                                  (cond
+                                   ((string=? name "LANG"))
+                                   (else
+                                    (let ((v (cgi:value name)))
+                                      (cond ((and v (not (string-null? v)))
+                                             (display "&amp;")
+                                             (display name)
+                                             (display "=")
+                                             (display v)))))))
+                                (cgi:names)))))))
+  
+    (do ((line (read-line) (read-line)))
+        ((eof-object? line) #f)
+      (expand-template explist line)
+      (newline))))
+
+(define (nea-rss-header)
+  (display "<?xml version=\"1.0\"?>\n")
+  (display "<rss version=\"2.0\">
+  <channel>
+    <title>Τα νέα</title>
+    <description>Τα νέα</description>
+    <link>http://ellinika.gnu.org.ua</link>")
+  (format #t "<language>~A</language>" (language-code target-language))
+  (display "
+    <generator>EllinikaNea</generator>
+    <copyright>2006 Sergey Poznyakoff</copyright>
+    <managingEditor>gray@gnu.org.ua</managingEditor>
+    <docs>http://blogs.law.harvard.edu/tech/rss</docs>
+"))
+
+(define (nea-rss-footer)
+  (display "  </channel>
+</rss>"))
+
+(define (nea-sql-connect)
+  (let ((conn (sql-connect
+               sql-iface sql-host sql-port sql-database
+               sql-username sql-password)))
+    (sql-query conn "SET NAMES utf8")
+    conn))
+
+(define (nea-rss)
+  (nea-rss-header)
+  (catch 'gsql-error
+         (lambda ()
+           (let ((conn (nea-sql-connect)))
+             (for-each
+              (lambda (tuple)
+                (display "<item>\n")
+                (display "<pubDate>")
+                (display (list-ref tuple 0))
+                (display "</pubDate>\n")
+                (display "<title>")
+                (let ((title (sql-query conn
+                                        (string-append
+                                         "SELECT header "
+                                         "FROM newsart "
+                                         "WHERE ident=" (list-ref tuple 2) " "
+                                         "AND lang='"
+                                         (get-sql-lang conn
+                                                       (list-ref tuple 2)
+                                                       (make-my-lang-list))
+                                        "' "
+                                        "LIMIT 1"))))
+                  (display (if (not (null? title))
+                               (caar title)
+                               (list-ref tuple 0))))
+                (display "</title>\n")
+                (display "<link>")
+                (display (string-append
+                          (string-downcase cgi-server-protocol-name)
+                          "://"
+                          cgi-server-hostname
+                          "/"
+                          (make-cgi-name cgi-script-name
+                                         "timestamp" (list-ref tuple 1))))
+                (display "</link>\n")
+                (display "</item>\n"))
+              (sql-query
+               conn
+               (string-append
+                "SELECT date,unix_timestamp(date),ident "
+                "FROM news "
+                "ORDER BY 1 DESC LIMIT 10")))))
+         (lambda (key err descr)
+           (sql-error-handler err descr)))
+  (nea-rss-footer))
+
+
+(define (get-article-by-timestamp ts)
+  (let ((tuples (sql-query
+                 conn
+                 "SELECT date,unix_timestamp(date),ident FROM news WHERE unix_timestamp(date)=" ts)))
+    (cond
+     (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"))))
+        (append
+         (list (list-ref res 0)
+               (list-ref res 1))
+         (car art)))))))
+
+
+;;; Main
+
+(cond
+ ((cgi:value "rss")
+  ifelse(IFACE,[CGI],
+         (display ["Content-type: text/xml; charset=utf-8\r\n\r\n"]),
+         (request-rec:set-content-type! Request ["text/xml; charset=UTF-8"]))
+  (nea-rss))
+ (else
+  (catch 'gsql-error
+         (lambda ()
+           ifelse(IFACE,[CGI],dnl
+           (display ["Content-type: text/html; charset=utf-8\r\n\r\n"]))
+           (set! conn (nea-sql-connect))
+           (cond
+            ((or (cgi:value "timestamp") (cgi:value "id"))
+             (let ((tuples (sql-query
+                            conn
+                            (string-append
+                             "SELECT date,unix_timestamp(date),ident "
+                             "FROM news "
+                             "WHERE "
+                             (cond
+                              ((cgi:value "timestamp") =>
+                               (lambda (ts)
+                                 (string-append "unix_timestamp(date)=" ts)))
+                              ((cgi:value "id") =>
+                               (lambda (id)
+                                 (string-append "ident=" id))))))))
+
+               (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)
+             nea-html)
+           
+           (sql-connect-close conn))
+         
+         (lambda (key err descr)
+           (with-input-from-file
+               (template-file target-language tmpl)
+             (lambda ()
+               (let ((explist
+                      (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 "@@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)
+                   (newline)))))))))
+         
+;;;; Local variables:
+;;;; mode: Scheme
+;;;; buffer-file-coding-system: utf-8
+;;;; End:
diff --git a/ellinika/cgi.scmi b/ellinika/cgi.scm4
index b4da8f9..dc7c05d 100644
--- a/ellinika/cgi.scmi
+++ b/ellinika/cgi.scm4
@@ -1,5 +1,4 @@
 ;;;;                                   -*- scheme -*-
-=AUTOGENERATED=
 ;;;; Greek Dictionary Web Engine
 ;;;; Copyright (C) 2005 Sergey Poznyakoff
 ;;;; 
@@ -17,24 +16,40 @@
 ;;;; along with this program; if not, write to the Free Software
 ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 ;;;;
-
 (define-module (ellinika cgi))
 
-(use-modules (www cgi)
+(use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
              (gamma gettext)
              (ellinika i18n))
-  
+
+ifelse(IFACE,[CGI],,dnl
+(define form-data
+  (append
+   (parse-form-data
+    (table:get (request-rec:subprocess-env Request) "QUERY_STRING"))
+   (if (= (request-rec:method-number Request) 2)
+       (parse-form-data (read-post-data Request))
+       '())))
+
+(define-public (cgi:value name)
+  (assoc-ref form-data name))
+
+(define-public (cgi:names)
+  (map car form-data))
+
+(define-public cgi-script-name
+  (table:get (request-rec:subprocess-env Request)
+             "SCRIPT_NAME"))
+)
+
+
 ;;; User-definable variables
-(define-public base-dir "=PREFIX=")
-(define-public html-dir "=HTMLDIR=")
-(define-public sysconf-dir "=SYSCONFDIR=")
-(define-public locale-path "=LOCALEDIR=:/usr/share/locale:/usr/local/share/locale")
+(define-public base-dir "PREFIX")
+(define-public html-dir "HTMLDIR")
+(define-public sysconf-dir "SYSCONFDIR")
+(define-public locale-path "LOCALEDIR:/usr/share/locale:/usr/local/share/locale")
 (define-public ref-loc #f)
 
-(define-public dict-cgi-path "cgi-bin/dict.cgi") 
-(define-public nea-cgi-path "cgi-bin/nea.cgi")         ;; Path to the cgi (relative
-                                                       ;; to the Base HREF)
-
 (define-public config-file-name "ellinika.conf")
 (define-public dict-template-file-name "dict.html")
 (define-public nea-template-file-name "nea.html")
@@ -142,7 +157,7 @@ THUNK.
       (if (file-exists? (template-file x template-file-name))
           (set! target-language x)))))
 ;;; Initialize i18n
-  (let ((x (locale-setup target-language "=PACKAGE=" locale-path)))
+  (let ((x (locale-setup target-language "PACKAGE" locale-path)))
     (if x
         (set! target-language x))))