1 files changed, 70 insertions, 0 deletions
diff --git a/index.scml b/index.scml
new file mode 100644
index 0000000..0201d5b
--- /dev/null
+++ b/index.scml
@@ -0,0 +1,70 @@
+<?guile
+;;;; Greek Dictionary Web Engine
+;;;; Copyright (C) 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.
+;;;;
+
+(define ellinika-document-root "/home/gray/public_html/ellinika")
+(define ellinika-default-language "ru")
+
+(define (get-dir-name)
+  (call-with-current-continuation
+   (lambda (return)
+     (for-each
+      (lambda (lang)
+	(let loop ((slang lang)
+		   (suff (list #\. #\_)))
+	  (let ((dir (string-append ellinika-document-root "/" slang)))
+	    (cond
+	     ((catch 'system-error
+		     (lambda ()
+		       (eq? (stat:type (stat dir)) 'directory))
+		     (lambda args
+		       #f))
+	      (return dir))
+	     ((not (null? suff))
+	      (let ((p (let itr ((sl suff))
+			 (if (null? sl)
+			     #f
+			     (let ((x (string-split slang (car sl))))
+			       (if (null? (cdr x))
+				   (itr (cdr sl))
+				   (cons (car x) (cdr sl))))))))
+		(if p
+		    (loop (car p) (cdr p)))))))))
+      
+      (map
+       (lambda (s)
+	 (cond
+	  ((string-split s #\;) =>
+	   (lambda (l)
+	     (car l)))
+	  (else
+	   s)))
+       (string-split 
+	(table:get (request-rec:subprocess-env Request) "HTTP_ACCEPT_LANGUAGE")
+	#\,)))
+     (string-append ellinika-document-root "/" ellinika-default-language))))
+
+(with-input-from-file
+    (string-append (get-dir-name) "/intro.html")
+  (lambda ()
+    (do ((line (read-line) (read-line)))
+	((eof-object? line))
+      (display line)
+      (newline))))
+
+?>