#| 
   Translation lookup server implementation.
   
   Author: Dmitri Hrapof <yavannadil@yahoo.com>
   Version: 0.4
   Copyright (C) 2004, 2005 Dmitri Hrapof

This file is part of Geiriadur.

Geiriadur 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, or (at your option)
any later version.

Geiriadur 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 Geiriadur; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  
|#

(in-package geiriadur)

(defun tow (tup)
  (dictionary:word
   :id (first tup)
   :lang (second tup)
   :prt (third tup)
   :value (fourth tup)
   :attr (fifth tup)
   :pron (sixth tup)))

(defun toe (tup)
  (dictionary:example
   :id (first tup)
   :first (third tup)
   :second (fourth tup)))

(defun tote (tup)
 (dictionary:translation
   :id (first tup)
   :first (tow (cdr tup))
   :second (tow (nthcdr 7 tup))
   :note (nth 13 tup)
   :usuality (nth 14 tup)
   :usage (mapcar #'toe (acquire-examples (first tup)))))

(defun ten (e)
  (dictionary:entry 
   :headword (tow (car e))
   :meanings (mapcar #'tote (cadr e))))

(defclass lookup-impl (dictionary:lookup-servant) ())

(corba:define-method 
 translate ((self lookup-impl) word from to)
 (mapcar #'ten (acquire-translations word from to)))

(corba:define-method 
 etalsnart ((self lookup-impl) word from to)
 (mapcar #'ten (acquire-translations word from to :reverse t)))

(corba:define-method 
 interpret ((self lookup-impl) word from to via)
 (mapcar #'ten (acquire-translations word from to :via via)))

(corba:define-method 
 find ((self lookup-impl) word to)
 (mapcar #'ten (acquire-translations word to)))

(corba:define-method 
 locate ((self lookup-impl) word from)
 (mapcar #'tow (acquire-words word from)))

(corba:define-method 
 paradigm ((self lookup-impl) word)
 (mapcar #'tow (acquire-forms word)))

(corba:define-method 
 enumerate ((self lookup-impl) from to)
 (loop for d being the hash-keys of (aref *p-by-1st* from to) 
    collect (tow (gethash d *s-by-id*))))

(defun g-mane (&optional nc)
  (if nc (db-init nc) (connect-to-db))
  (let ((orb (CORBA:ORB_init (list "-ORBPort" "2628")))
	(srv (make-instance 'lookup-impl)))
    (let ((poa (op:resolve_initial_references orb "RootPOA")))
      (op:activate_object poa srv)
      (op:activate (op:the_poamanager poa))
      (with-open-file 
       (wr "geiriadur.ior" :direction :output :if-exists :supersede)
       (format wr "~A~%" 
	       (op:object_to_string orb (op:servant_to_reference poa srv)))))
    #+sbcl
    (clorb::make-repl-happy)
    (handler-bind 
	((error 
	  (lambda (c)
	    (let ((*debug-io* *standard-output*))
	      (format *debug-io* "~%~a~%" c) 
	      #+sbcl (sb-debug:backtrace)
	      (finish-output *debug-io*))
	    (throw 'aga nil))))
      (loop do
	   (catch 'aga
	     (op:run orb)
		  )))))

(defun g-make ()
  (setf clorb::*log-level* 1000)
  (db-init nil)
  (with-open-file 
      (st "ystadegau.html" :direction :output :if-exists :supersede)
    (make-stats st))
  #+clisp
  (progn
    (ext:saveinitmem "geiriadur" :quiet t)
    (ext:bye))
  #+ccl
  (ccl:save-application "gdr" :toplevel-function #'geiriadur::g-mane
   :prepend-kernel t)
  #+sbcl
  (sb-ext:save-lisp-and-die 
   "gdr" :toplevel #'geiriadur::g-mane :executable t))