Revision: 6413
Author: ek.kato
Date: Wed Jun 2 05:21:11 2010
Log: - Enable generic IM to use composing text tables generated from
scm file.
* configure.ac (AC_CONFIG_FILES) : Add table/Makefile
* tables/Makefile.am : New.
* scm/rk.scm
- (rk-context) : Add find-seq and find-partial-seq member.
- (rk-context-new) : Set find-seq and find-partial-seq according
to rule type to enable use of composing table.
- (rk-find-longest-back-match) : Follow the change.
- (rk-find-longest-head) : Ditto.
- (rk-check-back-commit) : Ditto.
- (rk-partial-seq?) : Ditto.
- (rk-current-seq) : Ditto.
- (rk-proc-tail) : Ditto.
- (rk-push-key-front-match) : Ditto.
- (rk-push-key-last!) : Ditto.
* scm/Makefile.am (SCM_FILES) : Add ct.scm.
* scm/ct.scm : New. Provide rk-lib-find-seq and
rk-lib-find-partial-seq equivalent functions using uim-look.
* scm/xmload.scm
- (zm-init-handler) : Use generated composing table.
- (wb86-init-handler) : Ditto.
* Makefile.am (SUBDIRS) : Add tables directory.
http://code.google.com/p/uim/source/detail?r=6413
Added:
/trunk/scm/ct.scm
/trunk/tables
/trunk/tables/Makefile.am
Modified:
/trunk/Makefile.am
/trunk/configure.ac
/trunk/scm/Makefile.am
/trunk/scm/rk.scm
/trunk/scm/xmload.scm
=======================================
--- /dev/null
+++ /trunk/scm/ct.scm Wed Jun 2 05:21:11 2010
@@ -0,0 +1,83 @@
+;;;
+;;; 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.
+;;;;
+
+;; ct.scm: provides rk-lib equivalent functions using composing table
+;;
+;; table must be sorted
+;; rk-expect and rk-expect-key? are not ported from rk.scm yet
+
+(require-dynlib "look")
+
+(define ct-lib-find-seq
+ (lambda (seq table)
+ (let ((looked (look-lib-look
+ #f
+ #f
+ 1
+ (string-append (sys-pkgdatadir) "/tables/" table)
+ (apply string-append seq))))
+ (if (and
+ (not (null? looked))
+ (= (string-contains (car looked) " " 0) 0))
+ ;; found
+ (list (list seq) (read-from-string (car looked)))
+ #f))))
+
+;; return a rule of partial match
+(define ct-lib-find-partial-seq
+ (lambda (seq table)
+ ;; search 2 entries matching (including partial match) with look
+ (let ((looked (look-lib-look
+ #f
+ #f
+ 2
+ (string-append (sys-pkgdatadir) "/tables/" table)
+ (apply string-append seq))))
+ (if (not (null? looked))
+ (let ((first (car looked))
+ (second (if (null? (cdr looked))
+ '()
+ (car (cdr looked)))))
+ (cond
+ ;; second one is partial
+ ((and
+ (not (null? second))
+ (string=? (substring first 0 1) " "))
+ (let ((partial (string-to-list (car (string-split
second " "))))
+ (cands (apply string-append (cdr (string-split
second " ")))))
+ (list (list (append seq partial)) (read-from-string
cands))))
+ ;; first one is partial
+ ((not (string=? (substring first 0 1) " "))
+ (let ((partial (string-to-list (car (string-split
first " "))))
+ (cands (apply string-append (cdr (string-split
first " ")))))
+ (list (list (append seq partial)) (read-from-string
cands))))
+ (else
+ #f)))
+ #f))))
=======================================
--- /dev/null
+++ /trunk/tables/Makefile.am Wed Jun 2 05:21:11 2010
@@ -0,0 +1,39 @@
+tablesdir = $(pkgdatadir)/tables
+
+SCMS = wb86.scm zm.scm
+SCM_TABLES = wb86.table zm.table
+
+NATIVE_TABLES =
+
+GENERATED_TABLES = $(SCM_TABLES)
+
+TABLES = $(NATIVE_TABLES) $(GENERATED_TABLES)
+
+dist_tables_DATA = $(TABLES)
+
+MAINTAINERCLEANFILES = $(GENERATED_TABLES)
+
+UIM_SH = $(top_builddir)/uim/uim-sh
+UIM_SH_ENV = \
+ LIBUIM_SYSTEM_SCM_FILES=$(abs_top_srcdir)/sigscheme/lib \
+ LIBUIM_SCM_FILES=$(abs_top_srcdir)/scm \
+ LIBUIM_PLUGIN_LIB_DIR=$(abs_top_builddir)/uim/.libs \
+ UIM_DISABLE_NOTIFY=1
+
+#if MAINTAINER_MODE
+wb86.scm: $(top_srcdir)/scm/wb86.scm
+ cp $< $@
+
+zm.scm: $(top_srcdir)/scm/zm.scm
+ cp $< $@
+
+.scm.table:
+ $(MAKE) $(AM_MAKEFLAGS) -C $(top_builddir)/uim uim-sh && \
+ echo "(begin (load \"$<\") (for-each (lambda (key) (display (format \"~a
~W\n\" (apply string-append (caar key)) (cadr key)))) `basename
$< .scm`-rule))" | $(UIM_SH_ENV) $(UIM_SH) -b | grep -v "^#<undef>" | sort
$@
+#endif
+
+clean-genscm:
+ rm -f $(SCMS)
+
+clean-gentable:
+ rm -f $(GENERATED_TABLES)
=======================================
--- /trunk/Makefile.am Sat Sep 26 12:17:31 2009
+++ /trunk/Makefile.am Wed Jun 2 05:21:11 2010
@@ -4,7 +4,7 @@
SUBDIRS = m4 doc replace sigscheme uim scm test test2 \
gtk helper qt notify
SUBDIRS += qt4
-SUBDIRS += xim fep emacs po pixmaps examples
+SUBDIRS += xim fep emacs po pixmaps examples tables
EXTRA_DIST = RELNOTE ChangeLog.old autogen.sh make-dist.sh \
uim.pc.in uim.desktop uim.spec.in uim.spec \
=======================================
--- /trunk/configure.ac Tue May 25 01:47:24 2010
+++ /trunk/configure.ac Wed Jun 2 05:21:11 2010
@@ -1783,6 +1783,7 @@
fep/Makefile
emacs/Makefile
emacs/uim-version.el
+ tables/Makefile
test/Makefile
test2/Makefile
test2/run-singletest.sh
=======================================
--- /trunk/scm/Makefile.am Mon May 31 21:51:14 2010
+++ /trunk/scm/Makefile.am Wed Jun 2 05:21:11 2010
@@ -55,7 +55,8 @@
http-client.scm http-server.scm \
sxml-tools.scm sxpathlib.scm \
annotation.scm annotation-eb.scm \
- dynlib.scm
+ dynlib.scm \
+ ct.scm
ETAGS_ARGS=$(SCM_FILES) $(GENERATED_SCM_FILES)
=======================================
--- /trunk/scm/rk.scm Thu Apr 22 18:16:04 2010
+++ /trunk/scm/rk.scm Wed Jun 2 05:21:11 2010
@@ -33,54 +33,71 @@
; rk-lib-find-seq
; rk-lib-find-partial-seq
; rk-lib-expect-seq
+; rk-lib-expect-key?
;
; back match is mainly used for Hangul
+;
+; if "table" is provided as a rule, ct-lib-find-seq and ;
+; ct-lib-find-partial-seq are used to search words from sorted text
+; file.
(define-record 'rk-context
'((rule ())
(seq ())
(immediate-commit #f)
- (back-match #f)))
+ (back-match #f)
+ (find-seq #f)
+ (find-partial-seq #f)))
(define rk-context-new-internal rk-context-new)
(define rk-context-new
(lambda (rule immediate-commit back)
- (rk-context-new-internal rule () immediate-commit back)))
+ (if (string? rule)
+ (require "ct.scm"))
+ (let ((find-seq (if (string? rule)
+ ct-lib-find-seq
+ rk-lib-find-seq))
+ (find-partial-seq (if (string? rule)
+ ct-lib-find-partial-seq
+ rk-lib-find-partial-seq)))
+ (rk-context-new-internal rule () immediate-commit back find-seq
find-partial-seq))))
;; back match
(define rk-find-longest-back-match
- (lambda (rule seq)
+ (lambda (rule seq find-seq)
(if (not (null? seq))
- (if (rk-lib-find-seq seq rule)
+ (if (find-seq seq rule)
seq
- (rk-find-longest-back-match rule (cdr seq)))
+ (rk-find-longest-back-match rule (cdr seq) find-seq))
'())))
;; back match
(define rk-find-longest-head
- (lambda (rseq rule)
+ (lambda (rseq rule find-seq)
(let ((seq (reverse rseq)))
- (if (rk-lib-find-seq seq rule)
+ (if (find-seq seq rule)
seq
(if (not (null? rseq))
- (rk-find-longest-head (cdr rseq) rule)
+ (rk-find-longest-head (cdr rseq) rule find-seq)
'())))))
;; back match
(define rk-check-back-commit
(lambda (rkc rule rseq)
(let* ((seq (reverse rseq))
(len (length seq))
- (longest-tail (rk-find-longest-back-match rule seq))
- (longest-head (reverse (rk-find-longest-head rseq rule)))
+ (find-seq (rk-context-find-seq rkc))
+ (find-partial-seq (rk-context-find-partial-seq rkc))
+ (longest-tail (rk-find-longest-back-match rule seq find-seq))
+ (longest-head (reverse (rk-find-longest-head rseq rule find-seq)))
(head
(truncate-list seq
(- len (length longest-tail))))
- (partial (rk-lib-find-partial-seq seq rule))
+ (partial (find-partial-seq seq rule))
(tail-partial
(if (not (null? longest-tail))
- (rk-lib-find-partial-seq longest-tail rule)
+ (find-partial-seq longest-tail rule)
#f))
- (c (rk-lib-find-seq longest-tail rule))
- (t (rk-lib-find-seq seq rule))
+ (c (find-seq longest-tail rule))
+ (t (find-seq seq rule))
(res #f))
(and
(if (> len 0)
@@ -93,7 +110,7 @@
#f
#t)
(if (not tail-partial)
- (let ((matched (rk-lib-find-seq (reverse longest-head) rule))
+ (let ((matched (find-seq (reverse longest-head) rule))
(tail (reverse (truncate-list (reverse seq)
(- len
(length longest-head))))))
@@ -103,12 +120,12 @@
res
(or
(not (null? longest-tail))
- (rk-lib-find-partial-seq tail rule)))
+ (find-partial-seq tail rule)))
(rk-context-set-seq! rkc tail)
(rk-context-set-seq! rkc '())) ;; no match in rule
#f)
#t)
- (let ((matched (rk-lib-find-seq head rule)))
+ (let ((matched (find-seq head rule)))
(if matched
(set! res (cadr matched)))
(rk-context-set-seq! rkc (reverse longest-tail))))
@@ -118,7 +135,7 @@
(lambda (rkc s)
(if (null? s)
#f
- (rk-lib-find-partial-seq (reverse s) (rk-context-rule rkc)))))
+ ((rk-context-find-partial-seq rkc) (reverse s) (rk-context-rule
rkc)))))
;; API
(define rk-partial?
@@ -135,8 +152,9 @@
(define rk-current-seq
(lambda (rkc)
(let* ((s (rk-context-seq rkc))
- (rule (rk-context-rule rkc)))
- (rk-lib-find-seq (reverse s) rule))))
+ (rule (rk-context-rule rkc))
+ (find-seq (rk-context-find-seq rkc)))
+ (find-seq (reverse s) rule))))
;; API
(define rk-flush
@@ -207,8 +225,9 @@
(define rk-proc-tail
(lambda (context seq)
(let* ((rule (rk-context-rule context))
+ (find-seq (rk-context-find-seq context))
(old-seq
- (rk-lib-find-seq
+ (find-seq
(reverse (rk-context-seq context)) rule))
(res #f))
(if old-seq
@@ -285,7 +304,8 @@
((s (rk-context-seq rkc))
(s (cons key s))
(rule (rk-context-rule rkc))
- (seq (rk-lib-find-seq (reverse s) rule))
+ (find-seq (rk-context-find-seq rkc))
+ (seq (find-seq (reverse s) rule))
(res #f))
(set!
res
@@ -317,7 +337,8 @@
(let*
((s (rk-context-seq rkc))
(rule (rk-context-rule rkc))
- (seq (rk-lib-find-seq (reverse s) rule)))
+ (find-seq (rk-context-find-seq rkc))
+ (seq (find-seq (reverse s) rule)))
(rk-proc-end-seq rkc seq s)
)))
=======================================
--- /trunk/scm/xmload.scm Mon May 31 21:51:14 2010
+++ /trunk/scm/xmload.scm Wed Jun 2 05:21:11 2010
@@ -32,8 +32,7 @@
;;
(define zm-init-handler
(lambda (id im arg)
- (require "zm.scm")
- (generic-context-new id im zm-rule #f)))
+ (generic-context-new id im "zm.table" #f)))
(generic-register-im
'zm
@@ -45,8 +44,7 @@
(define wb86-init-handler
(lambda (id im arg)
- (require "wb86.scm")
- (generic-context-new id im wb86-rule #f)))
+ (generic-context-new id im "wb86.table" #f)))
(generic-register-im
'wb86
