diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-03-23 09:09:22 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-03-23 09:09:22 +0000 |
commit | 125dd021d7213641c0e7a442b37707c220d872bc (patch) | |
tree | 3f3a9e7435597e11cefed82313e3c660f88f9d7e /index.scml | |
parent | 6863adbfccd217d76b2af6778a7e469e033519a7 (diff) | |
download | ellinika-125dd021d7213641c0e7a442b37707c220d872bc.tar.gz ellinika-125dd021d7213641c0e7a442b37707c220d872bc.tar.bz2 |
New file
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@391 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'index.scml')
-rw-r--r-- | index.scml | 70 |
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)))) + +?> |