[uim-commit] r371 - in trunk: helper scm test uim
yamaken@freedesktop.org
yamaken@freedesktop.org
Thu Jan 27 19:12:55 PST 2005
Author: yamaken
Date: 2005-01-27 19:12:52 -0800 (Thu, 27 Jan 2005)
New Revision: 371
Modified:
trunk/helper/pref-gtk.c
trunk/scm/custom.scm
trunk/test/test-custom.scm
trunk/uim/uim-custom.c
Log:
* This commit performs adaptation of key-str representation for
uim-pref. Default representation may be changed to "always
capitalized letter keys with ignore-case" after discussion for
easy-to-recognize key configuration
* helper/pref-gtk.c
- (key_pref_set_value):
* Add conversion from " " to "space" for user convenience
* Add capitalization for alphabet keys for easy-to-recognize key
configuration. uim-custom performs implicit shift key
encoding/decoding appropriately. This feature is disabled at now
* scm/custom.scm
- (key-list->gui-key-list, gui-key-list->key-list): New variable
- (custom-key?): Accept translator-prefixes
- (custom-expand-key-references): Add key-str customizable
conversion for uim-pref
- (reversed-tag-prefix-alist): New variable
- (key-str->key-list, key-list->key-str, map-key-list-body,
map-key-list-letter, map-key-str, key-list-upcase,
key-list-downcase, key-list-visualize-space,
key-list-characterize-space, key-list-encode-shift,
key-list-decode-shift, key-list-ignore-regular-shift,
key-list-ignore-case, key-list-strip-translators,
key-list-export-as-basic, key-list-import-as-basic,
key-list-export-as-traditional, key-list-import-as-traditional,
key-str->gui-key-str, gui-key-str->key-str): New procedures for
customizable conversion for uim-pref
- (custom-set-value!, custom-definition-as-literal): Replace
define-key with combination of define and make-key-predicate to
allow flexible key binding
* test/test-custom.scm
- (test custom-key?, test custom-valid?): Accept translator-prefix
- (test custom-definition-as-literal): Follow the specificationn
change
Modified: trunk/helper/pref-gtk.c
===================================================================
--- trunk/helper/pref-gtk.c 2005-01-28 02:07:50 UTC (rev 370)
+++ trunk/helper/pref-gtk.c 2005-01-28 03:12:52 UTC (rev 371)
@@ -31,6 +31,7 @@
*/
+#include <glib.h>
#include <gtk/gtk.h>
#include <gdk/gdkkeysyms.h>
#include <string.h>
@@ -1223,6 +1224,13 @@
mod & GDK_MOD1_MASK);
switch (keyval) {
+ case GDK_space:
+ /*
+ * "space" is not proper uim keysym and only exists for user
+ * convenience. It is converted to " " by uim-custom
+ */
+ g_snprintf(keystr, len, "space");
+ break;
case GDK_BackSpace:
g_snprintf(keystr, len, "backspace");
break;
@@ -1308,7 +1316,24 @@
} else if (keyval >= GDK_F1 && keyval <= GDK_F35) {
g_snprintf(keystr, len, "%d", keyval - GDK_KP_0 + UKey_0);
} else if (keyval < 256) {
+#if 0
+ /*
+ * Capitalize alphabet keys for easy-to-recognize key
+ * configuration. uim-custom performs implicit shift key
+ * encoding/decoding appropriately.
+ *
+ * To test this feature, configure variables in custom.scm as
+ * following. -- YamaKen 2005-01-27
+ *
+ * (define key-list->gui-key-list 'key-list-export-as-basic)
+ * (define gui-key-list->key-list 'key-list-import-as-basic)
+ * ;;(define key-list->gui-key-list 'key-list-export-as-traditional)
+ * ;;(define gui-key-list->key-list 'key-list-import-as-traditional)
+ */
+ keystr[0] = g_ascii_toupper(keyval);
+#else
keystr[0] = keyval;
+#endif
keystr[1] = '\0';
} else {
/* UKey_Other */
Modified: trunk/scm/custom.scm
===================================================================
--- trunk/scm/custom.scm 2005-01-28 02:07:50 UTC (rev 370)
+++ trunk/scm/custom.scm 2005-01-28 03:12:52 UTC (rev 371)
@@ -37,7 +37,11 @@
(require "util.scm")
(require "key.scm")
-(define custom-full-featured? #t)
+;; config
+;;(define key-list->gui-key-list 'key-list-export-as-basic)
+;;(define gui-key-list->key-list 'key-list-import-as-basic)
+(define key-list->gui-key-list 'key-list-export-as-traditional)
+(define gui-key-list->key-list 'key-list-import-as-traditional)
;; public
(define custom-activity-hooks ())
@@ -49,6 +53,7 @@
(define custom-group-list-update-hooks ())
;; private
+(define custom-full-featured? #t)
(define custom-rec-alist ())
(define custom-group-rec-alist ())
(define custom-subgroup-alist ())
@@ -106,7 +111,8 @@
(and (list? key-repls)
(every (lambda (key)
(or (and (string? key) ;; "<Control>a"
- (valid-strict-key-str? key))
+ ;;(valid-strict-key-str? key)
+ (valid-key-str? key)) ;; acceps translators
(and (symbol? key) ;; 'generic-cancel-key
(custom-exist? key 'key))))
key-repls))))
@@ -115,7 +121,7 @@
(lambda (key)
(cond
((string? key)
- (list key))
+ (list (key-str->gui-key-str key)))
((list? key)
(append-map custom-expand-key-references key))
((and (symbol? key)
@@ -129,6 +135,175 @@
(lambda (custom-sym)
#f))
+(define reversed-tag-prefix-alist
+ (map (lambda (pair)
+ (cons (cdr pair)
+ (car pair)))
+ tag-prefix-alist))
+
+;; TODO: write test
+;; (key-str->key-list "<Control><Shift><IgnoreRegularShift>return")
+;; -> (Control_key Shift_key IgnoreRegularShift "return")
+;; (key-str->key-list "C-M-a")
+;; -> (Control_key Meta_key "a")
+(define key-str->key-list
+ (lambda (key-str)
+ (unfold (compose not car parse-key-prefix)
+ (compose car parse-key-prefix)
+ (compose cdr parse-key-prefix)
+ key-str
+ (compose list cdr parse-key-prefix))))
+
+;; TODO: write test
+(define key-list->key-str
+ (lambda (key-list)
+ (string-append-map
+ (lambda (elem)
+ (if (symbol? elem)
+ (let ((mod (cdr (assq elem reversed-tag-prefix-alist))))
+ (string-append "<" mod ">"))
+ elem))
+ key-list)))
+
+;; TODO: write test
+(define map-key-list-body
+ (lambda (body-mapper key-list)
+ (map (lambda (elem)
+ (if (string? elem)
+ (body-mapper elem)
+ elem))
+ key-list)))
+
+;; TODO: write test
+(define map-key-list-letter
+ (lambda (letter-mapper key-list)
+ (let ((letter (string->letter (find string? key-list))))
+ (map-key-list-body (lambda (elem)
+ (if letter
+ (charcode->string (letter-mapper letter))
+ elem))
+ key-list))))
+
+;; TODO: write test
+(define map-key-str
+ (lambda (key-list-mapper key-str)
+ (if (string? key-str)
+ (let ((key-list (key-str->key-list key-str)))
+ (key-list->key-str (key-list-mapper key-list)))
+ key-str)))
+
+;; TODO: write test
+(define key-list-upcase
+ (lambda (key-list)
+ (map-key-list-letter char-upcase key-list)))
+
+;; TODO: write test
+(define key-list-downcase
+ (lambda (key-list)
+ (map-key-list-letter char-downcase key-list)))
+
+;; TODO: write test
+(define key-list-visualize-space
+ (lambda (key-list)
+ (map-key-list-body (lambda (elem)
+ (if (string=? elem " ")
+ "space"
+ elem))
+ key-list)))
+
+;; TODO: write test
+(define key-list-characterize-space
+ (lambda (key-list)
+ (map-key-list-body (lambda (elem)
+ (if (string=? elem "space")
+ " "
+ elem))
+ key-list)))
+
+;; TODO: write test
+(define key-list-encode-shift
+ (lambda (key-list)
+ (let ((has-shift? (memq 'Shift_key key-list))
+ (letter (string->letter (find string? key-list))))
+ (filter-map (lambda (elem)
+ (cond
+ ((and (eq? elem 'Shift_key)
+ letter)
+ #f)
+ ((and (string? elem)
+ has-shift?
+ letter)
+ (charcode->string (char-upcase letter)))
+ (else
+ elem)))
+ key-list))))
+
+;; TODO: write test
+(define key-list-decode-shift
+ (lambda (key-list)
+ (let* ((letter (string->letter (find string? key-list)))
+ (upper-case? (and letter
+ (char-upper-case? letter)))
+ (has-shift? (memq 'Shift_key key-list))
+ (stripped (key-list-downcase key-list)))
+ (if (and (not has-shift?)
+ upper-case?)
+ (cons 'Shift_key stripped)
+ stripped))))
+
+;; TODO: write test
+(define key-list-ignore-regular-shift
+ (lambda (key-list)
+ (let ((letter (string->letter (find string? key-list))))
+ (if letter
+ (cons 'IgnoreShift key-list)
+ key-list))))
+
+;; TODO: write test
+(define key-list-ignore-case
+ (lambda (key-list)
+ (let ((letter (string->letter (find string? key-list))))
+ (if letter
+ (cons 'IgnoreCase key-list)
+ key-list))))
+
+;; TODO: write test
+(define key-list-strip-translators
+ (lambda (key-list)
+ (remove translator-prefix? key-list)))
+
+;; TODO: write test
+(define key-list-export-as-basic (compose key-list-visualize-space
+ key-list-upcase
+ key-list-decode-shift
+ key-list-strip-translators))
+
+;; TODO: write test
+(define key-list-import-as-basic (compose key-list-characterize-space
+ key-list-ignore-case
+ key-list-encode-shift
+ key-list-downcase))
+
+;; TODO: write test
+(define key-list-export-as-traditional (compose key-list-visualize-space
+ key-list-strip-translators))
+
+;; TODO: write test
+(define key-list-import-as-traditional (compose key-list-characterize-space
+ key-list-ignore-regular-shift))
+
+;; TODO: write test
+(define key-str->gui-key-str
+ (lambda (key-str)
+ (map-key-str (symbol-value key-list->gui-key-list)
+ key-str)))
+
+;; TODO: write test
+(define gui-key-str->key-str
+ (lambda (key-str)
+ (map-key-str (symbol-value gui-key-list->key-list)
+ key-str)))
+
(define custom-choice-label
(lambda (custom-sym val-sym)
(let* ((sym-rec-alist (custom-type-attrs custom-sym))
@@ -319,8 +494,10 @@
(set-symbol-value! sym val)
(if (eq? (custom-type sym)
'key)
- (define-key-internal (symbolconc sym '?)
- (custom-modify-key-predicate-names val)))
+ (let ((key-val (custom-modify-key-predicate-names val)))
+ (eval (list 'define (symbolconc sym '?)
+ (list 'make-key-predicate (list 'quote key-val)))
+ toplevel-env)))
(custom-call-hook-procs sym custom-set-hooks)
(let ((post-activities (map custom-active? custom-syms)))
(for-each (lambda (another-sym pre post)
@@ -445,7 +622,8 @@
(let ((key-val (custom-list-as-literal
(custom-modify-key-predicate-names
(custom-value sym)))))
- (list "\n(define-key " var "? " key-val ")"))
+ (list "\n(define " var "? "
+ "(make-key-predicate " key-val "))"))
())))))))
;; API
Modified: trunk/test/test-custom.scm
===================================================================
--- trunk/test/test-custom.scm 2005-01-28 02:07:50 UTC (rev 370)
+++ trunk/test/test-custom.scm 2005-01-28 03:12:52 UTC (rev 371)
@@ -278,8 +278,8 @@
;; null key is invalid
(assert-false (uim-bool '(custom-key? '(""))))
;; custom-key cannot contain key with translator
- (assert-false (uim-bool '(custom-key? '("<IgnoreShift>0"))))
- (assert-false (uim-bool '(custom-key?
+ (assert-true (uim-bool '(custom-key? '("<IgnoreShift>0"))))
+ (assert-true (uim-bool '(custom-key?
'("<IgnoreShift><IgnoreCase>return"))))
;; custom-key cannot contain raw closure
(assert-false (uim-bool '(custom-key? (list test-cancel-key))))
@@ -1657,8 +1657,8 @@
;; siod interprets #f as ()
;;(assert-false (uim-bool '(custom-valid? 'test-cancel-key #f)))
(assert-false (uim-bool '(custom-valid? 'test-cancel-key '(""))))
- (assert-false (uim-bool '(custom-valid? 'test-cancel-key '("<IgnoreShift>0"))))
- (assert-false (uim-bool '(custom-valid? 'test-cancel-key '("<IgnoreShift><IgnoreCase>return"))))
+ (assert-true (uim-bool '(custom-valid? 'test-cancel-key '("<IgnoreShift>0"))))
+ (assert-true (uim-bool '(custom-valid? 'test-cancel-key '("<IgnoreShift><IgnoreCase>return"))))
(assert-false (uim-bool '(custom-valid? 'test-cancel-key (list test-cancel-key))))
(assert-false (uim-bool '(custom-valid? 'test-cancel-key '(test-nonexistent-key))))
(assert-false (uim-bool '(custom-valid? 'test-cancel-key '("nonexistent"))))
@@ -2116,9 +2116,9 @@
(uim '(custom-definition-as-literal 'test-available-ims)))
(assert-equal "(define test-null-ims '())"
(uim '(custom-definition-as-literal 'test-null-ims)))
- (assert-equal "(define test-cancel-key '(\"<Control>g\" \"escape\"))\n(define-key test-cancel-key? '(\"<Control>g\" \"escape\"))"
+ (assert-equal "(define test-cancel-key '(\"<Control>g\" \"escape\"))\n(define test-cancel-key? (make-key-predicate '(\"<Control>g\" \"escape\")))"
(uim '(custom-definition-as-literal 'test-cancel-key)))
- (assert-equal "(define test-null-key '())\n(define-key test-null-key? '())"
+ (assert-equal "(define test-null-key '())\n(define test-null-key? (make-key-predicate '()))"
(uim '(custom-definition-as-literal 'test-null-key)))
(assert-equal "(define test-use-candidate-window? #t)"
(uim '(custom-definition-as-literal 'test-use-candidate-window?)))
Modified: trunk/uim/uim-custom.c
===================================================================
--- trunk/uim/uim-custom.c 2005-01-28 02:07:50 UTC (rev 370)
+++ trunk/uim/uim-custom.c 2005-01-28 03:12:52 UTC (rev 371)
@@ -1011,7 +1011,7 @@
{
char *val;
val = key_list_to_str((const struct uim_custom_key *const *)custom->value->as_key, " ");
- UIM_EVAL_FSTRING2(NULL, "(custom-set-value! '%s '(%s))", custom->symbol, val);
+ UIM_EVAL_FSTRING2(NULL, "(custom-set-value! '%s (map gui-key-str->key-str '(%s)))", custom->symbol, val);
free(val);
}
break;
More information about the Uim-commit
mailing list