[uim-commit] r950 - branches/composer/scm
yamaken at freedesktop.org
yamaken at freedesktop.org
Fri Jul 8 22:44:58 EST 2005
Author: yamaken
Date: 2005-07-08 05:44:54 -0700 (Fri, 08 Jul 2005)
New Revision: 950
Added:
branches/composer/scm/utext.scm
Modified:
branches/composer/scm/Makefile.am
branches/composer/scm/event.scm
branches/composer/scm/load-action.scm
branches/composer/scm/ng-action.scm
branches/composer/scm/ng-anthy.scm
branches/composer/scm/ng-canna.scm
branches/composer/scm/segmental-converter.scm
branches/composer/scm/util.scm
Log:
* This commit adds 'utext' a flexible text representation
* scm/utext.scm
- New file
- (uchar-new, uchar-copy, uchar-body, uchar-props, uchar-prop,
uchar-add-prop, uchar-add-props, uchar-body?, uchar?, uchar=?,
utext-props-add, utext-props-merge, utext-prop?, utext-props?,
utext-props=?, utext-new, utext-copy, utext?, utext-add-prop,
utext-add-props, utext-length, utext-ref, utext-set!, utext=?,
utext-subtext, utext-subtext-rel, utext-aggregate,
eucjp-string->utext, utext->eucjp-string): New procedure
- (utext-prop-default-locale, utext-prop-eucjp-locale,
utext-props-eucjp-str, uchar-std-cursor): New variable
* scm/segmental-converter.scm
- (segconv-engine-set-source-str!): Follow the utext specification
change
- (segconv-engine-commit!, segconv-engine-resize-segment!,
segconv-engine-set-candidate-index!, segconv-engine-candidate):
Revise the specification comment to follow the utext specification
change
* scm/ng-anthy.scm
- (anthy-default-utext-props): New variable
- (anthy-engine-set-source-str!, anthy-engine-resize-segment!,
anthy-engine-set-candidate-index!, anthy-engine-candidate): Follow
the utext specification change
* scm/ng-canna.scm
- (canna-default-utext-props): New variable
- (canna-engine-set-source-str!, canna-engine-resize-segment!,
canna-engine-candidate): Follow the utext specification change
* scm/event.scm
- (record utext, record action-groups-req-event, record
action-groups-export-event, record actions-req-event, record
actions-export-event, record chooser-req-event, record
chooser-config-event, record indicator-req-event, record
indicator-config-event, record indicator-update-event): Removed
- (valid-event-types): Update
- (event-rec-spec): Split some members to downward-event-rec-spec
- (upward-event-rec-spec, downward-event-rec-spec): New variable
- (record upward-event, record downward-event, record
focus-in-event, record focus-out-event, record client-info-event,
record preedit-updated-event, record chooser-update-req-event):
New record
- (record timer-event, record reset-event, record action-event,
record key-event): Follow the changes about event records
- (record insert-event, record commit-event):
* Ditto
* Follow the specification changes of utext
- (record chooser-event, record chooser-update-event):
* Follow the changes about event records
* Restructure
* scm/Makefile.am
- (SCM_FILES): Add utext.scm
* scm/load-action.scm
- (do-nothing): Move to util.scm
* scm/util.scm
- (method-delegator-new, char?): New procedure
- (do-nothing): Moved from load-action.scm
* scm/ng-action.scm
- Add a comment
Modified: branches/composer/scm/Makefile.am
===================================================================
--- branches/composer/scm/Makefile.am 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/Makefile.am 2005-07-08 12:44:54 UTC (rev 950)
@@ -6,7 +6,8 @@
GENERATED_SCM_FILES = installed-modules.scm loader.scm
SCM_FILES = plugin.scm im.scm im-custom.scm lazy-load.scm init.scm \
default.scm \
- util.scm key.scm ustr.scm ng-action.scm action.scm load-action.scm i18n.scm \
+ util.scm key.scm ustr.scm utext.scm i18n.scm \
+ ng-action.scm action.scm load-action.scm \
ng-key.scm physical-key.scm event.scm evmap.scm evmap-csv.scm \
event-translator.scm \
key-custom.scm \
Modified: branches/composer/scm/event.scm
===================================================================
--- branches/composer/scm/event.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/event.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -35,45 +35,50 @@
;; on loose relationships. -- YamaKen 2005-02-18
(require "util.scm")
+(require "utext.scm")
(require "ng-key.scm")
-
;;
-;; utext
-;;
-
-;; The name 'utext' is inspired by Mtext of the m17n library
-(define-record 'utext
- '((str "")
- (language "")
- (encoding "")
- (props ()))) ;; arbitrary properties alist
-
-;; TODO:
-;; - character encoding conversion
-;; - encoding-aware string split
-;; - encoding name canonicalization
-;; - comparison
-
-;;
;; event definitions
;;
(define valid-event-types
- '(timer
+ '(unknown
+ client-info
reset
- action
- commit
+ focus-in
+ focus-out
+ key
insert
- key))
+ commit
+ preedit-updated
+
+ timer
+ timer-set
+
+ action
+ chooser
+ chooser-update-req
+ chooser-update
+ ))
+
(define event-rec-spec
- '((type unknown)
+ '((type unknown)))
+
+(define upward-event-rec-spec event-rec-spec)
+(define-record 'upward-event upward-event-rec-spec)
+
+(define downward-event-rec-spec
+ (append
+ event-rec-spec
+ '(;;(context-id -1)
(consumed #f)
(loopback #f) ;; instructs re-injection into local composer
(timestamp -1) ;; placeholder
- (ext-state #f)))
-(define-record 'event event-rec-spec)
+ (ext-state #f))))
+;; use 'event' instead of 'downward-event' as record name for convenient use
+(define-record 'event downward-event-rec-spec)
(define event-external-state
(lambda (ev state-id)
@@ -82,123 +87,85 @@
(state-reader state-id)))))
(define-record 'timer-event
- event-rec-spec)
+ downward-event-rec-spec)
(define-record 'reset-event
- event-rec-spec)
+ downward-event-rec-spec)
-(define-record 'commit-event
+(define-record 'focus-in-event
+ downward-event-rec-spec)
+
+(define-record 'focus-out-event
+ downward-event-rec-spec)
+
+(define-record 'client-info-event
(append
- event-rec-spec
- '((utexts ())
- (clear-preedit #t))))
+ downward-event-rec-spec
+ '((locale #f)
+ (bridge "") ;; "gtk", "uim-xim", "macuim", "scim-uim", ...
+ (application "") ;; acquire via bridge-dependent methods such as basename `echo $0`
+ (expected "")))) ;; "direct", "number", "upper-alphabet", "ja-hiragana", ...
-;; insert a text into preedit
+;; inserts a text into active IM context
+;; For example, this can be used to insert a kanji word via clipboard
+;; to register new dictionary entry
(define-record 'insert-event
(append
- event-rec-spec
- '((utext #f))))
+ downward-event-rec-spec
+ '((utext ()))))
+(define-record 'commit-event
+ (append
+ upward-event-rec-spec
+ '((utext ())
+ (preedit-utext ())))) ;; can also update preedit as atomic event
-;; action, chooser, and indicator events may be canged drastically
-;; -- YamaKen 2005-06-09
+(define-record 'preedit-updated-event
+ (append
+ upward-event-rec-spec))
-;; action
-
(define-record 'action-event
(append
- event-rec-spec
+ downward-event-rec-spec
'((action-id #f)))) ;; 'action_input_mode_direct
-(define-record 'action-groups-req-event
- event-rec-spec)
-
-(define-record 'action-groups-export-event
- (append
- event-rec-spec
- '((action-groups ())))) ;; list of action-group-id
-
-(define-record 'actions-req-event
- (append
- event-rec-spec
- '((action-group-id #f)))) ;; 'action_group_input_mode
-
-(define-record 'actions-export-event
- (append
- event-rec-spec
- '((action-group-id #f)
- (actions ())))) ;; list of action objects (!= action-id)
-
-;; chooser
-
(define-record 'chooser-event
(append
- event-rec-spec
+ downward-event-rec-spec
'((chooser-id #f) ;; 'chooser_candidate_selector
- (index -1) ;; negative value means no spot
- (scope-top -1)
- (finish #t))))
+ (chosen -1) ;; negative value means that nothing is chosen
+ (confirm #t) ;; finish current choice transaction
+ (scope-top -1))))
-(define-record 'chooser-req-event
+(define-record 'chooser-update-req-event
(append
- event-rec-spec
+ downward-event-rec-spec
'((chooser-id #f) ;; 'chooser_candidate_selector 'chooser_all etc.
- (config #f)
+ (initialize #f)
(items-top -1)
- (items-length -1))))
+ (nr-items -1))))
-(define-record 'chooser-config-event
- (append
- event-rec-spec
- '((chooser-id #f)
- (label "")
- (desc "")
- (scope-size-hint 10) ;; number of items displayable at a time
- (scope-top 0) ;; initial position of scope
- (nr-items 0)
- ;;(spot-pos -1)
- ;;(initial-items-top -1)
- ;;(initial-items ())
- )))
-
(define-record 'chooser-update-event
(append
- event-rec-spec
- '((chooser-id #f)
- (transition 'none) ;; 'activate 'deactivate 'none
- (scope-top -1)
- (spot-pos -1)
- (updated-items-top -1)
- (updated-items ()))))
+ upward-event-rec-spec
+ '((chooser-id #f)
+ (initialize #f) ;; invalidate all cached info about the chooser
+ (transition #f) ;; 'activate 'deactivate #f
+ (chooser-size -1) ;; number of items including hidden ones
+ (chosen -1) ;; item index currently chosen
+ (scope-top -1) ;;
+ (scope-size-hint -1) ;; number of items displayable at a time
+ (title #f) ;; indication
+ (status #f) ;; indication
+ (updated-items-top -1)
+ (updated-items ())))) ;; list of indications
-;; indicator
-
-(define-record 'indicator-req-event
- (append
- event-rec-spec
- '((indicator-id #f) ;; 'indicator_candidate_selector 'indicator_all etc.
- (config #f))))
-
-(define-record 'indicator-config-event
- (append
- event-rec-spec
- '((indicator-id #f) ;; 'indicator_input_mode
- (indicator-indication #f) ;; indication object for indicator itself
- (state-indication #f)))) ;; indication object for the content
-
-(define-record 'indicator-update-event
- (append
- event-rec-spec
- '((indicator-id #f)
- (state-indication #f))))
-
-
;; #f means "don't care" for lkey, pkey, str, press and autorepeat
;; when comparing with other key-event. But modifiers require exact
;; match.
(define-record 'key-event
(append
- event-rec-spec
+ downward-event-rec-spec
(list
;;(list text #f) ;; replace raw string with utext in future
(list 'str #f) ;; precomposed string
Modified: branches/composer/scm/load-action.scm
===================================================================
--- branches/composer/scm/load-action.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/load-action.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -75,9 +75,6 @@
(if enable-action?
(require "action.scm")
(begin
- (define do-nothing
- (lambda args
- #f))
(define register-widget do-nothing)
(define register-action do-nothing)
(define indicator-new do-nothing)
Modified: branches/composer/scm/ng-action.scm
===================================================================
--- branches/composer/scm/ng-action.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/ng-action.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -29,6 +29,8 @@
;;; SUCH DAMAGE.
;;;;
+;; FIXME: write test
+
(require "util.scm")
(require "i18n.scm")
(require "event.scm")
Modified: branches/composer/scm/ng-anthy.scm
===================================================================
--- branches/composer/scm/ng-anthy.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/ng-anthy.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -36,6 +36,7 @@
(define anthy-lib-initialized? #f)
(define anthy-default-locale (locale-new "ja_JP.EUC-JP"))
+(define anthy-default-utext-props (list (cons 'locale anthy-default-locale)))
(define anthy-intrinsic-transposition-hiragana? #f) ;; NTH_UNCONVERTED_CANDIDATE
(define anthy-intrinsic-transposition-katakana? #f)
(define anthy-intrinsic-transposition-halfkana? #f)
@@ -62,10 +63,9 @@
(ustr-clear! (anthy-engine-cand-indices self))))
(define anthy-engine-set-source-str!
- (lambda (self utexts)
+ (lambda (self utext)
(anthy-lib-set-string (anthy-engine-ac-id self)
- (string-append-map utext-str
- utexts))
+ (utext->eucjp-string utext))
(let ((nsegs (segconv-engine-nr-segments self))
(cands (anthy-engine-cand-indices self)))
(ustr-clear! cands)
@@ -99,7 +99,8 @@
(orig-pos (ustr-cursor-pos cands)))
(ustr-set-cursor-pos! cands iseg-idx)
(ustr-set-latter-seq! cands (make-list latter-nseg 0))
- (ustr-set-cursor-pos! cands orig-pos)))))
+ (ustr-set-cursor-pos! cands orig-pos)
+ seg-idx)))) ;; seg-idx..last-idx have been invalidated
(define anthy-engine-nr-candidates
(lambda (self seg-idx)
@@ -124,19 +125,18 @@
(cand-idx (anthy-engine-candidate-index self i)))
(anthy-lib-commit-segment ac-id iseg-idx cand-idx)
(segconv-engine-candidate self i cand-idx))))
- (utexts (append-map committer (iota (+ seg-idx 1)))))
+ (utext (append-map committer (iota (+ seg-idx 1)))))
(ustr-set-cursor-pos! cands iseg-idx)
(and (ustr-cursor-at-end? cands)
(ustr-clear! cands))
- utexts)))))
+ utext)))))
(define anthy-engine-candidate
(lambda (self seg-idx cand-idx)
(let ((ac-id (anthy-engine-ac-id self))
(iseg-idx (anthy-engine-internal-seg-idx self seg-idx))
(str (anthy-lib-get-nth-candidate ac-id iseg-idx cand-idx)))
- (list (utext-new str anthy-default-locale ;;'((ruby . "¤Õ¤ê¤¬¤Ê"))
- )))))
+ (eucjp-string->utext str))))
;; for partial commission feature
(define anthy-engine-nr-committed-segments
Modified: branches/composer/scm/ng-canna.scm
===================================================================
--- branches/composer/scm/ng-canna.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/ng-canna.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -36,6 +36,7 @@
(define canna-lib-initialized? #f)
(define canna-default-locale (locale-new "ja_JP.EUC-JP"))
+(define canna-default-utext-props (list (cons 'locale anthy-default-locale)))
(define canna-intrinsic-transposition-hiragana? #f) ;; RK_XFER
(define canna-intrinsic-transposition-katakana? #f) ;; RK_KFER
;;(define canna-intrinsic-transposition-halfkana? #f)
@@ -57,9 +58,9 @@
(canna-lib-reset-context (canna-engine-cc-id self))))
(define canna-engine-set-source-str!
- (lambda (self utexts)
+ (lambda (self utext)
(canna-lib-begin-conversion (canna-engine-cc-id self)
- (string-append-map utext-str utexts))))
+ (utext->eucjp-string utext))))
(define canna-engine-commit!
(lambda (self)
@@ -78,7 +79,8 @@
;; TODO: support other than -1 and 1 for offset
(define canna-engine-resize-segment!
(lambda (self seg-idx offset)
- (canna-lib-resize-segment (canna-engine-cc-id self) seg-idx offset)))
+ (canna-lib-resize-segment (canna-engine-cc-id self) seg-idx offset)
+ seg-idx))
(define canna-engine-nr-candidates
(lambda (self seg-idx)
@@ -101,7 +103,7 @@
(lambda (self seg-idx cand-idx)
(let ((cc-id (canna-engine-cc-id self))
(str (canna-lib-get-nth-candidate cc-id seg-idx cand-idx)))
- (list (utext-new str canna-default-locale)))))
+ (eucjp-string->utext str))))
(define canna-engine-method-table
Modified: branches/composer/scm/segmental-converter.scm
===================================================================
--- branches/composer/scm/segmental-converter.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/segmental-converter.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -31,7 +31,10 @@
;;;;
(require "util.scm")
+(require "utext.scm")
(require "composer.scm")
+(require "ng-action.scm")
+(require "chooser.scm")
;;
@@ -72,10 +75,10 @@
((segconv-engine-method-table-reset! self) self)))
(define segconv-engine-set-source-str!
- (lambda (self utexts)
- ((segconv-engine-method-table-set-source-str! self) self utexts)))
+ (lambda (self utext)
+ ((segconv-engine-method-table-set-source-str! self) self utext)))
-;; .returns Commit string as utext-list
+;; .returns Commit string as utext
(define segconv-engine-commit!
(lambda (self)
((segconv-engine-method-table-commit! self) self)))
@@ -89,7 +92,9 @@
(lambda (self seg-idx)
((segconv-engine-method-table-segment-source-length self) self seg-idx)))
-;; side effect: invalidates nr-segments and all segment info
+;; side effect: invalidates nr-segments and segment info
+;; .returns first segment index to be invalidated. ret..last-idx have
+;; been invalidated
(define segconv-engine-resize-segment!
(lambda (self seg-idx offset)
((segconv-engine-method-table-resize-segment! self) self seg-idx offset)))
@@ -104,12 +109,12 @@
;; side effect: invalidates nr-segments and all segment info
;; .parameter commit Instructs partial (sequencial) commit if #t
-;; .returns Commit string as utext-list if commit is #t
+;; .returns Commit string as utext if commit is #t
(define segconv-engine-set-candidate-index!
(lambda (self seg-idx cand-idx commit)
((segconv-engine-method-table-set-candidate-index! self) self seg-idx cand-idx commit)))
-;; .returns Converted segment string as utext-list
+;; .returns Converted segment string as utext
(define segconv-engine-candidate
(lambda (self seg-idx cand-idx)
((segconv-engine-method-table-candidate self) self seg-idx cand-idx)))
Added: branches/composer/scm/utext.scm
===================================================================
--- branches/composer/scm/utext.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/utext.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -0,0 +1,238 @@
+;;; utext.scm: Flexible text representation
+;;;
+;;; 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 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.
+;;;;
+
+;; FIXME: write test
+
+(require "util.scm")
+(require "i18n.scm")
+
+
+;; - The name 'utext' is inspired by Mtext of the m17n library
+;; - 'uchar' represents a logical character. Logical character is
+;; arbitrary length string such as "a", "ae", "ｶﾞ" or "". All of
+;; these objects are treated as one character on editing
+;; - To perform complex operation, use with ustr as (ustr-new utext)
+
+;; utext ::= () | (uchar . utext)
+;;
+;; uchar ::= uchar-body | (uchar-body . utext-props)
+;; uchar-body ::= char | string
+;; char ::= #\a | #\ã‚ | <any valid Scheme character>
+;; string ::= "" | "ae" | "abc" | "ガ" | "ｶﾞ" | "æ–‡å—列"
+;; | <any valid Scheme string>
+;;
+;; utext-props ::= (utext-prop) | (utext-prop . utext-props)
+;; utext-prop ::= (symbol . prop-value)
+;; prop-value ::= utext | <any valid Scheme object>
+
+
+;;
+;; uchar
+;;
+
+(define uchar-new
+ (lambda (body props)
+ (if (null? props)
+ body
+ (cons body props))))
+
+(define uchar-copy
+ (lambda (uchar)
+ (if (pair? uchar)
+ (cons (car uchar)
+ (cdr uchar))
+ uchar)))
+
+(define uchar-body
+ (lambda (uchar)
+ (if (pair? uchar)
+ (car uchar)
+ uchar)))
+
+(define uchar-props
+ (lambda (uchar)
+ (if (pair? uchar)
+ (cdr uchar)
+ ())))
+
+(define uchar-prop
+ (lambda (uchar prop-id)
+ (assq prop-id (uchar-props uchar))))
+
+(define uchar-add-prop
+ (lambda (uchar prop)
+ (uchar-new (uchar-body uchar)
+ (utext-props-add (uchar-props uchar) prop))))
+
+(define uchar-add-props
+ (lambda (uchar props)
+ (uchar-new (uchar-body uchar)
+ (utext-props-merge (uchar-props uchar) props))))
+
+(define uchar-body?
+ (lambda (obj)
+ (or (char? obj)
+ (string? obj))))
+
+(define uchar?
+ (lambda (obj)
+ (or (uchar-body? obj)
+ (and (pair? obj)
+ (uchar-body? (car obj))
+ (utext-props? (cdr obj))))))
+
+(define uchar=?
+ (lambda (uchar other)
+ (and (equal? (uchar-body uchar)
+ (uchar-body other))
+ (utext-props=? (uchar-props uchar)
+ (uchar-props other)))))
+
+
+;;
+;; utext property
+;;
+
+(define utext-props-add
+ (lambda (props new-prop)
+ (alist-replace new-prop props)))
+
+(define utext-props-merge
+ (lambda (props new-props)
+ (fold (lambda (p merged)
+ (utext-props-add merged p))
+ props
+ new-props)))
+
+(define utext-prop?
+ (lambda (obj)
+ (symbol? obj)
+ (and (pair? obj)
+ (symbol? (car obj)))))
+
+(define utext-props? pair?)
+
+;; FIXME: get lset=
+;;(define utext-props=?
+;; (lambda (utext other)
+;; (lset= equal? utext other)))
+(define utext-props=? equal?)
+
+
+;;
+;; utext
+;;
+
+(define utext-new
+ (lambda (uchar-bodies props)
+ (map (lambda (body)
+ (uchar-new body props))
+ uchar-bodies)))
+
+(define utext-copy
+ (lambda (utext)
+ (map uchar-copy utext)))
+
+(define utext?
+ (lambda (utext)
+ (every uchar? utext)))
+
+(define utext-add-prop
+ (lambda (utext prop)
+ (map (lambda (uchar)
+ (uchar-add-prop uchar prop))
+ utext)))
+
+(define utext-add-props
+ (lambda (utext props)
+ (map (lambda (uchar)
+ (uchar-add-props uchar props))
+ utext)))
+
+;; logical length (!= physical character count)
+(define utext-length length)
+
+;; FIXME: replace nth with list-ref
+(define utext-ref
+ (lambda (utext idx)
+ (nth idx utext)))
+
+;; FIXME: nthcdr
+(define utext-set!
+ (lambda (utext idx uchar)
+ (set-car! (list-tail utext idx)
+ uchar)))
+
+(define utext=?
+ (lambda (utext other)
+ (every uchar=? utext other)))
+
+(define utext-subtext
+ (lambda (utext start end)
+ (list-tail (list-head utext (+ end 1))
+ start)))
+
+(define utext-subtext-rel
+ (lambda (utext start len)
+ (utext-subtext start (+ start len))))
+
+;; .returns List of utext aggregated by uchar-props=?
+(define utext-aggregate
+ (lambda (utext)
+ ))
+
+;;(define utext-convert
+;; (lambda (utext new-locale)
+;; ))
+
+(define eucjp-string->utext
+ (lambda (str)
+ (fold (lambda (c utext)
+ (cons (uchar-new c utext-props-eucjp-str)
+ utext))
+ ()
+ (string-to-list str))))
+
+;; FIXME: support encoding conversion from other than EUC-JP
+(define utext->eucjp-string
+ (lambda (utext)
+ (string-append-map uchar-body utext)))
+
+
+;;
+;; standard definitions
+;;
+
+(define utext-prop-default-locale (cons 'locale (locale-new #f)))
+(define utext-prop-eucjp-locale (cons 'locale (locale-new "ja_JP.EUC-JP")))
+(define utext-props-eucjp-str (list utext-prop-eucjp-locale))
+(define uchar-std-cursor (cons "" (list utext-prop-default-locale
+ '(cursor . #t))))
Modified: branches/composer/scm/util.scm
===================================================================
--- branches/composer/scm/util.scm 2005-07-08 05:20:25 UTC (rev 949)
+++ branches/composer/scm/util.scm 2005-07-08 12:44:54 UTC (rev 950)
@@ -145,6 +145,13 @@
(car (reverse funcs))
(cdr (reverse funcs))))))
+(define method-delegator-new
+ (lambda (dest-getter method)
+ (lambda args
+ (let* ((self (car args))
+ (dest (dest-getter self)))
+ (apply method (cons dest (cdr args)))))))
+
;; TODO: write test
(define safe-car
(lambda (pair)
@@ -183,6 +190,11 @@
(lambda (x)
(number? x)))
+;; Siod doesn't support char
+(define char?
+ (lambda (x)
+ #f))
+
(define list?
(lambda (x)
(or (null? x)
@@ -542,6 +554,8 @@
;; uim-specific utilities
;;
+(define do-nothing (lambda args #f))
+
;; TODO: write test
(define make-scm-pathname
(lambda (file)
More information about the uim-commit
mailing list