Revision: 6469
Author: iratqq
Date: Mon Jun 21 04:36:03 2010
Log: * scm/dict-socket.scm:
* scm/annotation-dict.scm:
- New file.
* scm/Makefile.am (SCM_FILES):
- Add dict-socket.scm and annotation-dict.scm.
* scm/im-custom.scm (annotation-agent):
- Add dict.
(dict-server, dict-servname, dict-database, dict-cache-words):
- Add custom value.
Add supporting rfc2229 dict protocol.
http://code.google.com/p/uim/source/detail?r=6469
Added:
/trunk/scm/annotation-dict.scm
/trunk/scm/dict-socket.scm
Modified:
/trunk/scm/Makefile.am
/trunk/scm/im-custom.scm
=======================================
--- /dev/null
+++ /trunk/scm/annotation-dict.scm Mon Jun 21 04:36:03 2010
@@ -0,0 +1,68 @@
+;;; annotation-dict.scm: dict functions for uim
+;;;
+;;; Copyright (c) 2010 uim Project http://code.google.com/p/uim/
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; 3. Neither the name of authors nor the names of its contributors
+;;; may be used to endorse or promote products derived from this
software
+;;; without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
CONTRIBUTORS BE LIABLE
+;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT
+;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY
WAY
+;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;; SUCH DAMAGE.
+;;;;
+
+(require-extension (srfi 1))
+(require "util.scm")
+(require "dict-socket.scm")
+
+
+(define dict-port #f)
+(define dict-cache-alist '())
+
+(define (dict-init)
+ (and (provided? "socket")
+ (set! dict-port (dict-server-open dict-server dict-servname))))
+
+(define (dict-get-text-from-server text enc)
+ (apply string-append (dict-server-get-define dict-port dict-database
text)))
+
+(define (dict-get-text-with-cache text enc)
+ (let ((ret (assoc text dict-cache-alist)))
+ (if ret
+ (cdr ret)
+ (let ((new (dict-get-text-from-server text enc)))
+ (if (not (string=? new ""))
+ (set! dict-cache-alist (append dict-cache-alist (list (cons
text new)))))
+ (if (< dict-cache-words (length dict-cache-alist))
+ (set! dict-cache-alist (cdr dict-cache-alist)))
+ new))))
+
+
+(define (dict-get-text text enc)
+ (or (and dict-port
+ (dict-get-text-with-cache text enc))
+ ""))
+
+(define (dict-release)
+ (if dict-port
+ (begin
+ (dict-server-close dict-port)
+ (set! dict-port #f))))
=======================================
--- /dev/null
+++ /trunk/scm/dict-socket.scm Mon Jun 21 04:36:03 2010
@@ -0,0 +1,120 @@
+;;; dict.scm: rfc2229 (a dictionary server protocol) for uim.
+;;;
+;;; Copyright (c) 2010 uim Project http://code.google.com/p/uim/
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution.
+;;; 3. Neither the name of authors nor the names of its contributors
+;;; may be used to endorse or promote products derived from this
software
+;;; without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
CONTRIBUTORS BE LIABLE
+;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT
+;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY
WAY
+;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;; SUCH DAMAGE.
+;;;;
+
+(require-extension (srfi 1 8))
+
+(require "util.scm")
+(require "i18n.scm")
+(require "socket.scm")
+(require "fileio.scm")
+(require "lolevel.scm")
+(require "input-parse.scm")
+
+(define $DICT-DEFAULT-PORT 2628)
+
+(define (dict-server-error-responce? responce)
+ (define dict-server-typical-errors '(500 501 502 503 420 421))
+ (let ((errno (string->number responce)))
+ (and (not errno)
+ (find (lambda (n) (= errno n)) dict-server-typical-errors))))
+
+(define (dict-server-build-message command . messages)
+ (string-append
+ (string-join (append (list command) messages) " ")
+ "\r\n"))
+
+(define (dict-server-parse-responce line)
+ (define numbers '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+ (call-with-input-string
+ line
+ (lambda (port)
+ (let* ((responce (next-token-of numbers port))
+ (skip (skip-while '(#\space) port))
+ (message (next-token '(#\space) '(#\return *eof*) (N_ "dict:
Invalid message") port)))
+ (values responce message)))))
+
+(define (dict-server-get-1yz port)
+ (let loop ((line (file-read-line port))
+ (rest ""))
+ (if (string=? line ".\r")
+ (begin
+ (append (list rest) (dict-server-get-message port)))
+ (loop (file-read-line port) (string-append rest line)))))
+
+(define (dict-server-get-message port)
+ (let* ((line (file-read-line port)))
+ (receive (responce message)
+ (dict-server-parse-responce line)
+ (cond ((dict-server-error-responce? responce)
+ (uim-notify-fatal (format "dict (~a): ~a" (N_ "Error
Responce") message)))
+ ((string=? "151" responce)
+ (dict-server-get-1yz port))
+ ((string=? "150" responce)
+ (let* ((responce-line (file-read-line port)))
+ (receive (responce message)
+ (dict-server-parse-responce responce-line)
+ (if (string=? "151" (substring responce-line 0 3))
+ (dict-server-get-1yz port)
+ (uim-notify-fatal (format "dict (~a): ~a"
(N_ "Error Responce") message))))))
+ ((string=? "2" (substring responce 0 1))
+ '())
+ ((string=? "4" (substring responce 0 1))
+ '())
+ ((string=? "5" (substring responce 0 1))
+ '())
+ (else
+ (uim-notify-fatal (format "~a ~a" (N_ "dict: Protocol error")
message)))))))
+
+
+(define (dict-server-parse-banner port)
+ (dict-server-get-message port)) ;; get 1yz type message, maybe
+
+(define (dict-server-open hostname . args)
+ (let-optionals* args ((servname $DICT-DEFAULT-PORT))
+ (let ((fd (tcp-connect hostname servname)))
+ (if (not fd)
+ (uim-notify-fatal (N_ "dict: cannot connect server")))
+ (let ((port (open-file-port fd)))
+ (dict-server-parse-banner port)
+ port))))
+
+(define (dict-server-get-dictionary-list port)
+ (file-display (dict-server-build-message "SHOW" "DB") port)
+ (dict-server-get-message port))
+
+(define (dict-server-get-define port database word)
+ (file-display (dict-server-build-message "DEFINE" database word) port)
+ (dict-server-get-message port))
+
+(define (dict-server-close port)
+ (file-display (dict-server-build-message "Q") port)
+ (dict-server-get-message port) ;; bye
+ (close-file-port port))
=======================================
--- /trunk/scm/Makefile.am Wed Jun 2 20:52:32 2010
+++ /trunk/scm/Makefile.am Mon Jun 21 04:36:03 2010
@@ -54,9 +54,10 @@
input-parse.scm match.scm pregexp.scm \
http-client.scm http-server.scm \
sxml-tools.scm sxpathlib.scm \
- annotation.scm annotation-eb.scm \
+ annotation.scm annotation-eb.scm annotation-dict.scm \
dynlib.scm \
- ct.scm
+ ct.scm \
+ dict-socket.scm
OTHER_SCM_FILES = wb86.scm zm.scm
EXTRA_DIST = $(OTHER_SCM_FILES)
=======================================
--- /trunk/scm/im-custom.scm Tue Apr 27 18:51:37 2010
+++ /trunk/scm/im-custom.scm Mon Jun 21 04:36:03 2010
@@ -555,6 +555,9 @@
(list 'eb
(N_ "EB library")
(N_ "EB library"))
+ (list 'dict
+ (N_ "dict server")
+ (N_ "dict server"))
(list 'im
(N_ "Annotation from IM only")
(N_ "long description will be here.")))
@@ -612,6 +615,63 @@
(and enable-annotation?
(eq? annotation-agent 'eb))))
+;; dict server support
+(define-custom-group 'dict
+ (N_ "dict server")
+ (N_ "long description will be here."))
+
+(define-custom 'dict-server
+ "dict.org"
+ '(annotation dict)
+ '(string ".*")
+ (N_ "Server address of dict")
+ (N_ "long description will be here."))
+
+(define-custom 'dict-servname
+ 2628
+ '(annotation dict)
+ '(integer 0 65535)
+ (N_ "Server port of dict")
+ (N_ "long description will be here."))
+
+(define-custom 'dict-database
+ "web1913"
+ '(annotation dict)
+ '(string ".*")
+ (N_ "Database name of dict")
+ (N_ "long description will be here."))
+
+(define-custom 'dict-cache-words
+ 256
+ '(annotation dict)
+ '(integer 0 65535)
+ (N_ "Number of cache of annotation")
+ (N_ "long description will be here."))
+
+(custom-add-hook 'dict-server
+ 'custom-activity-hooks
+ (lambda ()
+ (and enable-annotation?
+ (eq? annotation-agent 'dict))))
+
+(custom-add-hook 'dict-servname
+ 'custom-activity-hooks
+ (lambda ()
+ (and enable-annotation?
+ (eq? annotation-agent 'dict))))
+
+(custom-add-hook 'dict-database
+ 'custom-activity-hooks
+ (lambda ()
+ (and enable-annotation?
+ (eq? annotation-agent 'dict))))
+
+(custom-add-hook 'dict-cache-words
+ 'custom-activity-hooks
+ (lambda ()
+ (and enable-annotation?
+ (eq? annotation-agent 'dict))))
+
;; uim-xim specific custom
(define-custom-group 'xim
(N_ "XIM")
