[uim-commit] r302 - in trunk: scm test
yamaken@freedesktop.org
yamaken@freedesktop.org
Sat Jan 15 03:06:32 PST 2005
Author: yamaken
Date: 2005-01-15 03:06:29 -0800 (Sat, 15 Jan 2005)
New Revision: 302
Added:
trunk/scm/lazy-load.scm
Modified:
trunk/scm/Makefile.am
trunk/scm/custom.scm
trunk/scm/im-custom.scm
trunk/scm/im.scm
trunk/scm/loader.scm
trunk/scm/plugin.scm
trunk/scm/util.scm
trunk/test/test-im.scm
Log:
* This commit implements user-specified "enabled IM list" and "lazy IM
loading" features. The lazy loading significantly reduces startup
time and memory consumption.
Per-user configuration works fine, but install-time stub-im
generation is not yet supported. So you have to run uim-pref & save
configuration. "enabled-im-list" in
~/.uim.d/customs/custom-global.scm controls which IMs should be
appeared to IM selection menus. This item may become editable by
uim-pref soon
* scm/lazy-load.scm
- New file to support lazy IM loading
- (stub-im-generate-init-handler, register-stub-im,
stub-im-generate-stub-im-list, stub-im-generate-all-stub-im-list):
New procedure
* scm/plugin.scm
- (required-modules-alist): Remove
- (currently-loading-module-name): New variable
- (require-module): Simplify
* scm/im.scm
- (record im): Add new member 'module-name'. register-im API is not
affected
- (normalize-im-list): New procedure
- (register-im): Support overwrite registration to allow stub-im
actualization
* test/test-im.scm
- (testcase im im-management, testcase im im-switching, testcase im
context management): Add explicit full module loading to setup to
follow user-enabled IM loading feature
- (test register-im): Follow the addition of 'module-name' of record
im
* scm/custom.scm
- (define-custom): Support overwrite registration
- (custom-value-as-literal): Fix invalid literalization for () as
list
* scm/loader.scm
- Perform full module loading only when lazy-load.scm is not loaded
* scm/im-custom.scm
- (custom-im-list-as-choice-rec): Split off responsibility of
reversing
- (custom custom-preserved-default-im-name): Add reverse
- (custom-default-enabled-im-list): Rename to custom-installed-im-list
- (custom-installed-im-list): New variable
- (enabled-im-list): Fix bootstrap-time (no per-user config file)
default value acquisition
- (custom-hook-literalize-enabled-im-list): New hook procedure to
generate stub-im definitions
* scm/Makefile.am
- (SCM_FILES): Add lazy-load.scm
Modified: trunk/scm/Makefile.am
===================================================================
--- trunk/scm/Makefile.am 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/Makefile.am 2005-01-15 11:06:29 UTC (rev 302)
@@ -1,7 +1,8 @@
EXTRA_DIST = $(SCM_FILES)
scmdir = $(datadir)/uim
scm_DATA = $(SCM_FILES)
-SCM_FILES = plugin.scm im.scm im-custom.scm loader.scm default.scm \
+SCM_FILES = plugin.scm im.scm im-custom.scm lazy-load.scm loader.scm \
+ default.scm \
util.scm key.scm ustr.scm action.scm load-action.scm i18n.scm \
uim-sh.scm custom.scm custom-rt.scm \
rk.scm \
Modified: trunk/scm/custom.scm
===================================================================
--- trunk/scm/custom.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/custom.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -256,16 +256,15 @@
(lambda (sym)
(assq sym custom-rec-alist)))
+;; TODO: rewrite test for overwriting
;; API
(define define-custom
(lambda (sym default groups type label desc)
(let ((crec (custom-rec-new sym default groups type label desc))
(primary-grp (car groups))
(subgrps (cons 'main (cdr groups))))
- (if (not (custom-rec sym))
- (begin
- (set! custom-rec-alist (cons crec custom-rec-alist))
- (custom-call-hook-procs primary-grp custom-group-update-hooks)))
+ (set! custom-rec-alist (alist-replace crec custom-rec-alist))
+ (custom-call-hook-procs primary-grp custom-group-update-hooks)
(if (not (symbol-bound? sym))
(let ((quoted-default (if (or (symbol? default)
(list? default))
@@ -402,6 +401,7 @@
lst)))
(string-append "'(" (string-join " " canonicalized) ")"))))
+;; rewrite test for () as list
;; API
(define custom-value-as-literal
(lambda (sym)
@@ -410,11 +410,6 @@
(as-string (lambda (s)
(string-append "\"" s "\""))))
(cond
- ((or (eq? val #f)
- (eq? type 'boolean))
- (if (eq? val #f)
- "#f"
- "#t"))
((eq? type 'integer)
(digit->string val))
((eq? type 'string)
@@ -425,7 +420,12 @@
(string-append "'" (symbol->string val)))
((or (eq? type 'ordered-list)
(eq? type 'key))
- (custom-list-as-literal val))))))
+ (custom-list-as-literal val))
+ ((or (eq? val #f)
+ (eq? type 'boolean))
+ (if (eq? val #f)
+ "#f"
+ "#t"))))))
;; Don't invoke this from a literalize-hook. It will cause infinite loop
(define custom-definition-as-literal
Modified: trunk/scm/im-custom.scm
===================================================================
--- trunk/scm/im-custom.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/im-custom.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -31,14 +31,15 @@
(require "i18n.scm")
+;; TODO: write test
(define custom-im-list-as-choice-rec
(lambda (lst)
- (reverse (map (lambda (im)
- (let ((sym (im-name im))
- (label-name (im-label-name im))
- (desc (im-short-desc im)))
- (custom-choice-rec-new sym label-name desc)))
- lst))))
+ (map (lambda (im)
+ (let ((sym (im-name im))
+ (label-name (im-label-name im))
+ (desc (im-short-desc im)))
+ (custom-choice-rec-new sym label-name desc)))
+ lst)))
(define-custom-group 'global
(_ "Global settings")
@@ -68,7 +69,7 @@
'(global default-im-name)
(cons
'choice
- (custom-im-list-as-choice-rec im-list))
+ (custom-im-list-as-choice-rec (reverse im-list)))
(_ "Default input method")
(_ "long description will be here."))
@@ -128,18 +129,41 @@
;; Enabled IM list
;;
-(define custom-default-enabled-im-list
- (custom-im-list-as-choice-rec im-list))
+(define custom-installed-im-list
+ (begin
+ (if (symbol-bound? 'installed-im-module-list)
+ (for-each require-module installed-im-module-list))
+ (custom-im-list-as-choice-rec (reverse im-list))))
(define-custom 'enabled-im-list
- (map custom-choice-rec-sym custom-default-enabled-im-list)
+ (map custom-choice-rec-sym custom-installed-im-list)
'(global)
(cons
'ordered-list
- custom-default-enabled-im-list)
+ custom-installed-im-list)
(_ "Enabled input methods")
(_ "long description will be here."))
+;; bootstrap
+(if (and (symbol-bound? 'installed-im-module-list)
+ (null? enabled-im-list))
+ (custom-set-value! 'enabled-im-list
+ (map custom-choice-rec-sym custom-installed-im-list)))
+
+(define custom-hook-literalize-enabled-im-list
+ (lambda ()
+ (require "lazy-load.scm")
+ (string-append
+ "(define enabled-im-list "
+ (custom-value-as-literal 'enabled-im-list)
+ ")\n"
+ "(require \"lazy-load.scm\")\n\n"
+ (string-join "\n" (stub-im-generate-stub-im-list enabled-im-list)))))
+
+(custom-add-hook 'enabled-im-list
+ 'custom-literalize-hooks
+ custom-hook-literalize-enabled-im-list)
+
;;
;; im-switching
;;
Modified: trunk/scm/im.scm
===================================================================
--- trunk/scm/im.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/im.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -58,6 +58,7 @@
;;
(define im-list ())
+;; TODO: rewrite test for module-name
(define-record 'im
(list
(list 'name #f) ;; must be first member
@@ -74,7 +75,8 @@
(list 'reset-handler list)
(list 'get-candidate-handler list)
(list 'set-candidate-index-handler list)
- (list 'prop-activate-handler list)))
+ (list 'prop-activate-handler list)
+ (list 'module-name "")))
(define im-custom-set-handler
(lambda (im)
@@ -82,6 +84,17 @@
custom-prop-update-custom-handler
list)))
+;; TODO: write test
+(define normalize-im-list
+ (lambda ()
+ (let ((ordinary-im-list (alist-delete 'direct im-list eq?))
+ (direct-im (retrieve-im 'direct)))
+ (if direct-im
+ (set! im-list (cons direct-im
+ ordinary-im-list))))))
+
+;; TODO: rewrite test
+;; accepts overwrite register
(define register-im
(lambda (name lang encoding label-name short-desc init-arg init release
mode key-press key-release reset
@@ -89,10 +102,11 @@
(let ((im (im-new name lang encoding label-name short-desc
init-arg init release
mode key-press key-release reset
- get-candidate set-candidate-index prop)))
- (if (im-register-im name lang encoding short-desc)
- (set! im-list (cons im im-list))
- #f))))
+ get-candidate set-candidate-index prop
+ currently-loading-module-name)))
+ (set! im-list (alist-replace im im-list))
+ (normalize-im-list)
+ (im-register-im name lang encoding short-desc))))
;; called from C
(define uim-get-im-short-desc
Added: trunk/scm/lazy-load.scm
===================================================================
--- trunk/scm/lazy-load.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/lazy-load.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -0,0 +1,94 @@
+;;; lazy-load.scm: Lazy IM loading support
+;;;
+;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; 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 REGENTS 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 REGENTS 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.
+;;;;
+
+;; TODO: write test
+
+(require "util.scm")
+
+(define stub-im-generate-init-handler
+ (lambda (name module-name)
+ (lambda (id fake-im fake-arg)
+ (and (require-module module-name)
+ (let* ((im (retrieve-im name))
+ (init-handler (im-init-handler im))
+ (arg (im-init-arg im))
+ (context (init-handler id im arg)))
+ context)))))
+
+(define register-stub-im
+ (lambda (name lang encoding label-name short-desc module-name)
+ (if (or (not (retrieve-im name))
+ (not (im-key-press-handler (retrieve-im name))))
+ (let ((init-handler (stub-im-generate-init-handler name module-name)))
+ (register-im
+ name
+ lang
+ encoding
+ label-name
+ short-desc
+ #f ;; arg
+ init-handler
+ #f ;; release-handler
+ #f ;; mode-handler
+ #f ;; press-key-handler
+ #f ;; release-key-handler
+ #f ;; reset-handler
+ #f ;; get-candidate-handler
+ #f ;; set-candidate-index-handler
+ #f ;; prop-activate-handler
+ )
+ (im-set-module-name! (retrieve-im name) module-name)))))
+
+;; side effect: invoke require-module for all installed IM modules
+(define stub-im-generate-stub-im-list
+ (lambda (im-names)
+ (for-each require-module installed-im-module-list)
+ (map (lambda (name)
+ (let* ((im (retrieve-im name))
+ (name-str (symbol->string name)))
+ (string-append
+ "(if (and (symbol-bound? '*lazy-load.scm-loaded*)\n"
+ " (member '" name-str " enabled-im-list))\n"
+ " (register-stub-im\n"
+ " '" name-str "\n"
+ " \"" (im-lang im) "\"\n"
+ " \"" (im-encoding im) "\"\n"
+ " \"" (im-label-name im) "\"\n"
+ " \"" (im-short-desc im) "\"\n"
+ " \"" (im-module-name im) "\"))\n")))
+ im-names)))
+
+;; side effect: invoke require-module for all IM listed in
+;; installed-im-module-list
+(define stub-im-generate-all-stub-im-list
+ (lambda ()
+ (stub-im-generate-stub-im-list (map im-name
+ (reverse im-list)))))
Modified: trunk/scm/loader.scm
===================================================================
--- trunk/scm/loader.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/loader.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -61,6 +61,6 @@
;;"scim"
))
-;; don't touch this. This code will be removed once the
-;; enabled-im-list feature is implemented
-(for-each require-module installed-im-module-list)
+;; don't touch this
+(if (not (symbol-bound? '*lazy-load.scm-loaded*))
+ (for-each require-module installed-im-module-list))
Modified: trunk/scm/plugin.scm
===================================================================
--- trunk/scm/plugin.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/plugin.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -92,26 +92,19 @@
(plugin-entry-quit-proc entry)))))
-;; holds list of (module-name provided-im-name1 provided-im-name2 ...)
-;; e.g. '("pyload" py pyunihan pinyin-big5)
-(define required-modules-alist ())
-
-;; The name 'module' is imported from a post from Hiroyuki. If you
+;; The name 'module' is adopted from a post from Hiroyuki. If you
;; feel bad about the meaning of 'module', post your opinion to
;; uim@fdo.
+
+(define currently-loading-module-name #f)
+
;;
;; TODO: write test
-;; returns provided im-names
+;; returns whether initialization is succeeded
(define require-module
(lambda (module-name)
- (let ((pre-im-list im-list))
- (or (load-plugin module-name)
- (require (string-append module-name ".scm")))
- (let* ((post-im-list im-list)
- (nr-new-ims (- (length post-im-list)
- (length pre-im-list)))
- (new-ims (list-head post-im-list nr-new-ims))
- (provided (reverse (map im-name new-ims))))
- (set! required-modules-alist (cons (cons module-name provided)
- required-modules-alist))
- provided))))
+ (set! currently-loading-module-name module-name)
+ (let ((succeeded (or (load-plugin module-name)
+ (try-require (string-append module-name ".scm")))))
+ (set! currently-loading-module-name #f)
+ succeeded)))
Modified: trunk/scm/util.scm
===================================================================
--- trunk/scm/util.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/scm/util.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -364,11 +364,13 @@
;; uim-specific utilities
;;
+;; TODO: suppress error messages
;; returns succeeded or not
(define try-load
(lambda (file)
(not (*catch 'errobj (load file)))))
+;; TODO: suppress error messages
;; returns succeeded or not
(define try-require
(lambda (file)
Modified: trunk/test/test-im.scm
===================================================================
--- trunk/test/test-im.scm 2005-01-15 10:52:17 UTC (rev 301)
+++ trunk/test/test-im.scm 2005-01-15 11:06:29 UTC (rev 302)
@@ -48,6 +48,7 @@
(define-uim-test-case "testcase im im-management"
(setup
(lambda ()
+ (uim '(for-each require-module installed-im-module-list))
(uim '(define prev-im #f))
(uim '(define prev-nr-ims (length im-list)))
(uim '(define test-im-init-args #f))
@@ -78,7 +79,7 @@
(uim '(length im-list)))
(assert-equal 'test-im
(uim '(im-name (retrieve-im 'test-im #f))))
- (assert-equal 15
+ (assert-equal 16
(uim '(length (retrieve-im 'test-im #f))))
;; duplicate register will be rejected
@@ -501,6 +502,7 @@
(define-uim-test-case "testcase im im-switching"
(setup
(lambda ()
+ (uim '(for-each require-module installed-im-module-list))
(uim '(define test-im-anthy #f))
(uim '(define test-im-skk #f))
(uim '(define test-im-tcode #f))
@@ -556,6 +558,7 @@
(define-uim-test-case "testcase im context management"
(setup
(lambda ()
+ (uim '(for-each require-module installed-im-module-list))
;; define as hand-made data to avoid that implementation of
;; register-context affect other tests
(uim '(begin
More information about the Uim-commit
mailing list