diff options
Diffstat (limited to 'cgi-bin/dict.cgi.in')
-rw-r--r-- | cgi-bin/dict.cgi.in | 258 |
1 files changed, 173 insertions, 85 deletions
diff --git a/cgi-bin/dict.cgi.in b/cgi-bin/dict.cgi.in index 01eb926..3369db5 100644 --- a/cgi-bin/dict.cgi.in +++ b/cgi-bin/dict.cgi.in @@ -1,7 +1,8 @@ #! =GUILE_BINDIR=/guile -s +=AUTOGENERATED= !# ;;;; Greek Dictionary Web Engine -;;;; Copyright (C) 2004 Sergey Poznyakoff +;;;; Copyright (C) 2004, 2005 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 @@ -158,16 +159,58 @@ (string->list string))))) (define (get-topic-list) - (let ((conn (sql-connect sql-iface sql-host sql-port sql-database - sql-username sql-password))) - (cond - (conn - (let ((result (sql-query conn "SELECT ident,title FROM topic ORDER BY title"))) - (sql-connect-close conn) - result)) - (else - #f)))) - + (let ((categories #f)) + (letrec ((getcat + (lambda () + (let ((conn (sql-connect sql-iface sql-host sql-port sql-database + sql-username sql-password))) + (cond + (conn + (let ((categories (sql-query + conn + "SELECT category, title, description FROM category ORDER BY category"))) + (let ((result (if (null? categories) + '() + (map + (lambda (category) + (let ((topics (sql-query + conn + (string-append + "SELECT ident,title FROM topic WHERE category=" + (car category))))) + (append category (if (null? topics) + '() + (list topics))))) + categories)))) + (sql-connect-close conn) + result))) + (else + '())))))) + (if (not categories) + (set! categories (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) @@ -190,10 +233,15 @@ (display "\"")))) (display "> </TD> -</TR> +</TR>") + + (display "<TR><TD COLSPAN=\"3\" ALIGN=\"center\">") + (display (_"Συμπληρωματικοί όροι")) + (display "</TD></TR>") + + (display " <TR> <TD>") - (display (_"Επιλέξτε το μέρος του λόγου")) (display "</TD><TD>") @@ -219,49 +267,62 @@ part-of-speech) (display "</SELECT>")) - (display " - </TD> -</TR> -<TR> - <TD>") - - (display (_"Επιλέξτε το θέμα")) (display "</TD><TD>") - (let ((topic-list (get-topic-list))) - (if topic-list - (let ((selected-choice (or (let ((s (cgi:value "TOPIC"))) - (if s - (string->number s) - #f)) - 0))) - (display "<SELECT NAME=\"TOPIC\" TABINDEX=\"3\">") - (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))) - topic-list) - (display "</SELECT>")))) + (join-widget "pos" "3") + (display "</TD></TR>") - (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=\"2\" align=center> <INPUT TYPE=\"submit\" NAME=\"search\" VALUE=\"") - (display (_"Αναζήτηση")) - (display "\" TABINDEX=\"4\"> + (display (_"Αναζήτηση")) + (display "\" TABINDEX=\"") + (display tabindex) + (display "\"> </TD> </TR> </TABLE> </FORM> -<P>")) +<P>"))) ;; (define (replace-tilde word sentence) @@ -364,40 +425,55 @@ (display "</H2>")) (define (fuzzy-search conn key theme pos) - (let ((result (sql-query conn - (cond - ((> (string->number theme) 0) - (string-append - "SELECT DISTINCT dict.word FROM dict,topic_tab WHERE " - (cond - ((not (string-null? key)) - (string-append "dict.sound LIKE \"" - (ellinika:sounds-like key) - "%\" AND ")) - (else - "")) - "topic_tab.topic_ident=" - theme - " AND topic_tab.word_ident=dict.ident " - (if (> (string->number pos) 0) - (let ((pos-entry - (list-ref part-of-speech (string->number pos)))) - (string-append "AND dict.pos & " - (cdr pos-entry))) - "") - " order by word")) - (else - (string-append - "SELECT DISTINCT word FROM dict WHERE sound like \"" - (ellinika:sounds-like key) - "%\" " - (if (> (string->number pos) 0) - (let ((pos-entry (list-ref part-of-speech - (string->number pos)))) - (string-append "AND dict.pos &" - (cdr pos-entry))) - "") - " ORDER BY WORD")))))) + (let* ((query (string-append + "SELECT DISTINCT dict.word FROM dict,topic_tab WHERE " + + (if (not (null? theme)) + " topic_tab.word_ident=dict.ident " + "") + + (cond + ((not (string-null? key)) + (string-append + (if (not (null? theme)) + "AND" "") + " dict.sound LIKE \"" + (ellinika:sounds-like key) + "%\" ")) + (else + " ")) + + (cond + ((> (string->number pos) 0) + (let ((pos-entry + (list-ref part-of-speech (string->number pos)))) + (string-append + (if (or (not (string-null? key)) (not (null? theme))) + (if (string=? (cgi:value "joinpos") "0") + "AND" + "OR") + "") + " dict.pos & " + (cdr pos-entry) + " "))) + (else + " ")) + + (apply + string-append + (map + (lambda (x) + (cond + ((boolean? x) + (if x "AND " "OR ")) + (else + (string-append "topic_tab.topic_ident=" x " ")))) + theme)) + + " ORDER BY dict.word")) + + (result (sql-query conn query))) + (cond ((null? result) (search-failure key)) @@ -421,13 +497,25 @@ (let ((keyval (if (cgi:value "IDENT") (dict:decode-string (cgi:value "IDENT")) (cgi:value "key"))) - (theme (or (cgi:value "TOPIC") "0")) + (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"))) + (cond ((and keyval (not (string-null? keyval)) - (= (string->number theme) 0) + (null? theme) (= (string->number pos) 0)) + (let ((conn (sql-connect sql-iface sql-host sql-port sql-database sql-username sql-password))) @@ -473,7 +561,7 @@ (display-xref x (_"См. также "))))) (sort-result result)))) (sql-connect-close conn)))))) - ((or (> (string->number theme) 0) (> (string->number pos) 0)) + ((or (not (null? theme)) (> (string->number pos) 0)) (let ((conn (sql-connect sql-iface sql-host sql-port sql-database sql-username sql-password))) @@ -483,7 +571,7 @@ (_"ΣΦΆΛΜΑ: σύνδεση με το λέξικο απέτυχε."))) (else (display "<HR>") - (fuzzy-search conn "" theme pos) + (fuzzy-search conn (ellinika:translate-input (or keyval "")) theme pos) (sql-connect-close conn)))))))) ;;; |