[uim-commit] r283 - in trunk: scm test uim
yamaken@freedesktop.org
yamaken@freedesktop.org
Fri Jan 14 05:10:34 PST 2005
Author: yamaken
Date: 2005-01-14 05:10:32 -0800 (Fri, 14 Jan 2005)
New Revision: 283
Added:
trunk/scm/custom-rt.scm
Modified:
trunk/scm/Makefile.am
trunk/scm/custom.scm
trunk/test/test-custom.scm
trunk/uim/uim.c
Log:
* This commit adds lightweight version of uim-custom facility named
custom-rt.scm, and Fix a bug related to custom type 'key'
* scm/custom.scm
- (custom-set-value!): Fix broken define-key invocation. The test
for the case is added to test-custom.scm and validated
- (record custom-choice-rec): Move to custom-rt.scm
- (custom-add-hook, define-custom): Mark as API
- (custom-definition-as-literal): Simplify
- (custom-reload-customs): New procedure to support
custom-rt.scm. The test for this procedure is not yet available
- Add custom-reload-customs at end of file
* scm/custom-rt.scm
- New file
- All codes are not yet validated by testing framework
- (record custom-choice-rec): Moved from custom.scm
- (custom-required-custom-files, custom-rt-primary-groups): New
variables
- (custom-load-group-conf, require-custom,
custom-modify-key-predicate-names, custom-rt-add-primary-groups):
New procedure
- (custom-list-primary-groups, custom-add-hook, define-custom-group,
custom-exist?, custom-value, define-custom,
custom-prop-update-custom-handler): New procedure. These
procedures are lightweight or dummy version of same name ones in
custom.scm. They are overridden by full-featured version once the
custom.scm has been loaded
* scm/Makefile.am
- (SCM_FILES): Add custom-rt.scm
* test/test-custom.scm
- (testcase custom custom-group, testcase custom custom-group
methods): Modify loading process of custom.scm to conform to
introduction of custom-rt.scm
- (test define-custom (key)): Add a test for key reference
* uim/uim.c
- (uim_init_scm):
* Replace custom.scm with custom-rt.scm
* Load plugin.scm before custom-rt.scm
* Replace uim_scm_require_file("custom-vars.scm") and
uim_custom_load() with require-custom
Modified: trunk/scm/Makefile.am
===================================================================
--- trunk/scm/Makefile.am 2005-01-14 11:45:59 UTC (rev 282)
+++ trunk/scm/Makefile.am 2005-01-14 13:10:32 UTC (rev 283)
@@ -21,7 +21,7 @@
latin.scm \
zaurus.scm \
romaja.scm pyunihan.scm pyload.scm m17nlib.scm \
- uim-sh.scm custom.scm custom-vars.scm \
+ uim-sh.scm custom.scm custom-rt.scm custom-vars.scm \
pinyin-big5.scm \
plugin.scm
Added: trunk/scm/custom-rt.scm
===================================================================
--- trunk/scm/custom-rt.scm 2005-01-14 11:45:59 UTC (rev 282)
+++ trunk/scm/custom-rt.scm 2005-01-14 13:10:32 UTC (rev 283)
@@ -0,0 +1,140 @@
+;;; custom-rt.scm: Partial customization support for runtime input
+;;; processes
+;;;
+;;; Copyright (c) 2003-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.
+;;;;
+
+;; This file provides partial custom definition support for runtime
+;; input processes. The processes that wants full-featured custom API
+;; such as uim-pref must overrides these definitions by loading
+;; custom.scm.
+;;
+;; The name 'custom-rt' is not the best to represent this partial
+;; functionality. Give me better name. -- YamaKen 2005-01-14
+
+;; TODO: write test-custom-rt.scm
+
+(require "util.scm")
+(require "key.scm")
+
+(define-record 'custom-choice-rec
+ '((sym #f)
+ (label "")
+ (desc "")))
+
+(define custom-required-custom-files ())
+(define custom-rt-primary-groups ())
+
+;; full implementation
+(define custom-load-group-conf
+ (lambda (gsym)
+ (let* ((group-name (symbol->string gsym))
+ (path (string-append (getenv "HOME")
+ "/.uim.d/customs/custom-"
+ group-name
+ ".scm")))
+ (load path))))
+
+;; full implementation
+(define require-custom
+ (lambda (filename)
+ (let ((pre-groups (custom-list-primary-groups)))
+ (require filename)
+ (if (not (member filename custom-required-custom-files))
+ (set! custom-required-custom-files
+ (cons filename custom-required-custom-files)))
+ (let* ((post-groups (custom-list-primary-groups))
+ (nr-new-groups (- (length post-groups)
+ (length pre-groups)))
+ (new-groups (list-head post-groups nr-new-groups)))
+ (if (not (getenv "LIBUIM_VANILLA"))
+ (for-each custom-load-group-conf
+ (reverse new-groups)))))))
+
+;; full implementation
+(define custom-modify-key-predicate-names
+ (lambda (keys)
+ (map (lambda (key)
+ (if (symbol? key)
+ (symbolconc key '?)
+ key))
+ keys)))
+
+;; full implementation
+(define custom-rt-add-primary-groups
+ (lambda (gsym)
+ (if (not (member gsym custom-rt-primary-groups))
+ (set! custom-rt-primary-groups
+ (cons gsym custom-rt-primary-groups)))))
+
+;; lightweight implementation
+(define custom-list-primary-groups
+ (lambda ()
+ custom-rt-primary-groups))
+
+;; lightweight implementation
+(define custom-add-hook
+ (lambda (custom-sym hook-sym proc)
+ #f))
+
+;; lightweight implementation
+(define define-custom-group
+ (lambda (gsym label desc)
+ #f))
+
+;; lightweight implementation
+(define custom-exist?
+ (lambda (sym type)
+ #t))
+
+;; lightweight implementation
+(define custom-value
+ (lambda (custom-sym)
+ (symbol-value custom-sym)))
+
+;; lightweight implementation
+(define define-custom
+ (lambda (sym default groups type label desc)
+ (custom-rt-add-primary-groups (car groups))
+ (if (not (symbol-bound? sym))
+ (if (eq? (car type)
+ 'key)
+ (define-key-internal (symbolconc sym '?)
+ (custom-modify-key-predicate-names default))
+ (let ((quoted-default (if (or (symbol? default)
+ (list? default))
+ (list 'quote default)
+ default)))
+ (eval (list 'define sym quoted-default)
+ toplevel-env))))))
+
+;; lightweight implementation
+(define custom-prop-update-custom-handler
+ (lambda (context custom-sym val)
+ #f))
Modified: trunk/scm/custom.scm
===================================================================
--- trunk/scm/custom.scm 2005-01-14 11:45:59 UTC (rev 282)
+++ trunk/scm/custom.scm 2005-01-14 13:10:32 UTC (rev 283)
@@ -126,11 +126,6 @@
(lambda (custom-sym)
#f))
-(define-record 'custom-choice-rec
- '((sym #f)
- (label "")
- (desc "")))
-
(define custom-choice-label
(lambda (custom-sym val-sym)
(let* ((sym-rec-alist (custom-type-attrs custom-sym))
@@ -213,6 +208,7 @@
(custom-rec-sym crec)))
custom-rec-alist))))
+;; API
(define custom-add-hook
(lambda (custom-sym hook-sym proc)
(set-symbol-value! hook-sym (cons (cons custom-sym proc)
@@ -260,6 +256,7 @@
(lambda (sym)
(assq sym custom-rec-alist)))
+;; API
(define define-custom
(lambda (sym default groups type label desc)
(let ((crec (custom-rec-new sym default groups type label desc))
@@ -320,7 +317,8 @@
(set-symbol-value! sym val)
(if (eq? (custom-type sym)
'key)
- (define-key-internal (symbolconc sym '?) val))
+ (define-key-internal (symbolconc sym '?)
+ (custom-modify-key-predicate-names val)))
(custom-call-hook-procs sym custom-set-hooks)
(let ((post-activities (map custom-active? custom-syms)))
(for-each (lambda (another-sym pre post)
@@ -443,11 +441,8 @@
(if (eq? (custom-type sym)
'key)
(let ((key-val (custom-list-as-literal
- (map (lambda (key)
- (if (symbol? key)
- (symbolconc key '?)
- key))
- (custom-value sym)))))
+ (custom-modify-key-predicate-names
+ (custom-value sym)))))
(list "\n(define-key " var "? " key-val ")"))
())))))))
@@ -474,3 +469,11 @@
(and (valid? custom-sym)
(let ((cb (lambda () (gate-func func ptr custom-sym))))
(custom-add-hook custom-sym hook cb)))))
+
+(define custom-reload-customs
+ (lambda ()
+ (for-each (lambda (file)
+ (load file))
+ (reverse custom-required-custom-files))))
+
+(custom-reload-customs)
Modified: trunk/test/test-custom.scm
===================================================================
--- trunk/test/test-custom.scm 2005-01-14 11:45:59 UTC (rev 282)
+++ trunk/test/test-custom.scm 2005-01-14 13:10:32 UTC (rev 283)
@@ -29,12 +29,13 @@
;;; SUCH DAMAGE.
;;;;
-;; This file is tested with revision 254 of new repository
+;; This file is tested with revision 282 of new repository
;; TODO:
;;
-;; custom-broadcast-custom
+;; custom-reload-customs
;; custom-broadcast-customs
+;; custom-broadcast-customs
(use test.unit)
@@ -345,7 +346,12 @@
(setup
(lambda ()
(uim '(begin
- (load "custom.scm") ;; to reset previously defined groups
+ (require "custom.scm")
+ ;; to reset previously defined groups
+ (define custom-rec-alist ())
+ (define custom-group-rec-alist ())
+ (define custom-subgroup-alist ())
+
(define test-group-recs-length 0)
(define-custom-group 'global
(_ "Global settings")
@@ -694,7 +700,7 @@
(define-uim-test-case "testcase custom custom-group methods"
(setup
(lambda ()
- ;;(uim '(load "custom.scm"))
+ (uim '(require "custom.scm"))
(uim '(define-custom-group
'test-group
"test group"
@@ -1453,6 +1459,7 @@
(uim 'test-style)))
("test define-custom (key)"
+ ;; single key str
(assert-false (uim-bool '(symbol-bound? 'test-foo-key)))
(assert-false (uim-bool '(symbol-bound? 'test-foo-key?)))
@@ -1466,8 +1473,25 @@
(assert-equal '("a")
(uim 'test-foo-key))
(assert-true (uim-bool '(symbol-bound? 'test-foo-key?)))
- (assert-true (uim-bool '(test-foo-key? (string->charcode "a") 0))))
+ (assert-true (uim-bool '(test-foo-key? (string->charcode "a") 0)))
+ ;; key reference + key str
+ (assert-false (uim-bool '(symbol-bound? 'test-bar-key)))
+ (assert-false (uim-bool '(symbol-bound? 'test-bar-key?)))
+
+ (uim '(define-custom 'test-bar-key '(test-foo-key "b")
+ '(global)
+ '(key)
+ "test bar key"
+ "long description will be here"))
+
+ (assert-true (uim-bool '(symbol-bound? 'test-bar-key)))
+ (assert-equal '(test-foo-key "b")
+ (uim 'test-bar-key))
+ (assert-true (uim-bool '(symbol-bound? 'test-bar-key?)))
+ (assert-true (uim-bool '(test-bar-key? (string->charcode "a") 0)))
+ (assert-true (uim-bool '(test-bar-key? (string->charcode "b") 0))))
+
("test define-custom (key) #2"
(uim '(define test-foo-key '("b")))
(assert-false (uim-bool '(symbol-bound? 'test-foo-key?)))
Modified: trunk/uim/uim.c
===================================================================
--- trunk/uim/uim.c 2005-01-14 11:45:59 UTC (rev 282)
+++ trunk/uim/uim.c 2005-01-14 13:10:32 UTC (rev 283)
@@ -663,28 +663,17 @@
uim_scm_set_lib_path((scm_files) ? scm_files : SCM_FILES);
uim_scm_require_file("im.scm");
-#if 0
- /* lightweight version of custom.scm - not yet implemented */
- uim_scm_require_file("custom-rt.scm");
-#else
- uim_scm_require_file("custom.scm");
-#endif
uim_scm_require_file("plugin.scm");
+ uim_scm_require_file("custom-rt.scm");
uim_scm_load_file("loader.scm");
uim_scm_require_file("direct.scm"); /* must be loaded at last of IMs */
-#if 1
+
+#ifndef UIM_COMPAT_CUSTOM
/*
Remove this code once the definition of custom-vars.scm is
distributed into IM files -- YamaKen 2005-01-08
*/
- uim_scm_require_file("custom-vars.scm");
-#endif
-
-#ifndef UIM_COMPAT_CUSTOM
- /* must be loaded after IMs and before user conf */
- if (!getenv("LIBUIM_VANILLA")) {
- uim_custom_load();
- }
+ UIM_EVAL_STRING(NULL, "(require-custom \"custom-vars.scm\")");
#endif
if (getenv("LIBUIM_VANILLA") ||
load_conf() == -1) {
More information about the Uim-commit
mailing list