Author: yamakenz
Date: Wed Jul 11 05:02:30 2007
New Revision: 4704
Modified:
trunk/doc/COMPATIBILITY
trunk/scm/custom-rt.scm
trunk/scm/custom.scm
trunk/scm/deprecated-util.scm
trunk/scm/uim-module-manager.scm
trunk/scm/uim-sh.scm
trunk/scm/ustr.scm
trunk/scm/util.scm
trunk/test/test-custom-rt.scm
trunk/test/test-custom.scm
trunk/test/test-ustr.scm
trunk/test/test-util.scm
Log:
* scm/util.scm
- (writeln): New procedure
- (define-record): Replace deprecated procedure
* scm/ustr.scm
- (ustr-set-cursor-pos!): Ditto
* scm/custom.scm
- (custom-set-value!, custom-value-as-literal): Ditto
* scm/custom-rt.scm
- (custom-modify-key-predicate-names, custom-key-exist?,
custom-set-value!, define-custom): Ditto
* scm/uim-module-manager.scm
- (add-modules-to-module-list): Ditto
* scm/uim-sh.scm
- (uim-sh-loop, activate-editline): Ditto
* scm/deprecated-util.scm
- Add a comment about deprecated procedures
* test/test-util.scm
* test/test-ustr.scm
* test/test-custom.scm
* test/test-custom-rt.scm
- Update the "passed revision" comment
* doc/COMPATIBILITY
- Update "Specification changes of utility procedures"
Modified: trunk/doc/COMPATIBILITY
==============================================================================
--- trunk/doc/COMPATIBILITY (original)
+++ trunk/doc/COMPATIBILITY Wed Jul 11 05:02:30 2007
@@ -61,7 +61,7 @@
Affects: uim developers, IM developers
Updates: Scheme API
Version: 1.5.0
-Revision: ac4693, ac4694, ac4698, ac4699, ac4703
+Revision: ac4693, ac4694, ac4698, ac4699, ac4703, ac4704
Date: 2007-07-11
Modifier: YamaKen
Related:
@@ -73,6 +73,7 @@
(changed) string-join
(changed) sublist
(changed) sublist-rel
+ (new) writeln
Description:
- 'join' has been replaced with 'list-join'. The args are swapped
- Now string-split produces empty strings as follows. See
Modified: trunk/scm/custom-rt.scm
==============================================================================
--- trunk/scm/custom-rt.scm (original)
+++ trunk/scm/custom-rt.scm Wed Jul 11 05:02:30 2007
@@ -130,7 +130,7 @@
(lambda (keys)
(map (lambda (key)
(if (symbol? key)
- (symbolconc key '?)
+ (symbol-append key '?)
key))
keys)))
@@ -190,7 +190,7 @@
;; lightweight implementation
(define custom-key-exist?
(lambda (sym)
- (let ((key-sym (symbolconc sym '?)))
+ (let ((key-sym (symbol-append sym '?)))
(and (symbol-bound? sym)
(list? (symbol-value sym))
(symbol-bound? key-sym)
@@ -209,7 +209,7 @@
((custom-key-exist? sym)
(set-symbol-value! sym val)
(let ((key-val (custom-modify-key-predicate-names val)))
- (eval (list 'define (symbolconc sym '?)
+ (eval (list 'define (symbol-append sym '?)
(list 'make-key-predicate (list 'quote key-val)))
(interaction-environment)))
#t)
@@ -241,7 +241,7 @@
(begin
(if (eq? (car type)
'key)
- (eval (list 'define (symbolconc sym '?) list)
+ (eval (list 'define (symbol-append sym '?) list)
(interaction-environment)))
(custom-set-value! sym default)))))))) ;; to apply hooks
Modified: trunk/scm/custom.scm
==============================================================================
--- trunk/scm/custom.scm (original)
+++ trunk/scm/custom.scm Wed Jul 11 05:02:30 2007
@@ -568,7 +568,7 @@
(if (eq? (custom-type sym)
'key)
(let ((key-val (custom-modify-key-predicate-names val)))
- (eval (list 'define (symbolconc sym '?)
+ (eval (list 'define (symbol-append sym '?)
(list 'make-key-predicate (list 'quote key-val)))
(interaction-environment))))
(custom-call-hook-procs sym custom-set-hooks)
@@ -684,7 +684,7 @@
(type (custom-type sym)))
(cond
((eq? type 'integer)
- (digit->string val))
+ (number->string val))
((eq? type 'string)
(string-escape val))
((eq? type 'pathname)
Modified: trunk/scm/deprecated-util.scm
==============================================================================
--- trunk/scm/deprecated-util.scm (original)
+++ trunk/scm/deprecated-util.scm Wed Jul 11 05:02:30 2007
@@ -28,26 +28,35 @@
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
+;; To find deprecated procedure invocation, type as follows (or type
+;; it into M-x grep). But replacement of the deprecated procedures are
+;; not necessary for uim 1.5. Keeping in mind avoiding the procedures
+;; on writing a new code is enough. -- YamaKen 2007-07-11
+;;
+;; $ egrep
'\((string-list-concat|string-find|truncate-list|list-head|nconc|string-to-list|symbolconc|nth|nthcdr|copy-list|digit->string|puts|siod-print|print|feature\?|uim-symbol-value-str)\b'
*.scm
+
(use srfi-1)
(use srfi-34)
+;; TODO: rewrite list processing with 'string-append'
(define string-list-concat
(lambda (lst)
(apply string-append (reverse lst))))
+;; TODO: replace with 'member'
(define string-find
(lambda (lst str)
(member str lst)))
-;; should be obsoleted by 'take'
+;; TODO: replace with 'take'
(define truncate-list
(lambda (lst n)
(guard (err
(else #f))
(take lst n))))
-;; should be obsoleted by 'take'
+;; TODO: replace with 'take'
(define list-head take)
(define nconc
@@ -58,6 +67,7 @@
(set-cdr! (last-pair lst) obj)
lst))))
+;; TODO: rewrite list processing with 'string->list'
;; split EUC-JP string into reversed character list
(define string-to-list
(lambda (s)
@@ -67,29 +77,32 @@
(list->string (list c)))
(reverse! (string->list s)))))))
-;; symbol-append is not yet defined at here.
+;; TODO: replace with symbol-append
+;;
+;; Since symbol-append is not yet defined at here, enclose into closure.
;;(define symbolconc symbol-append)
(define symbolconc
(lambda args
(apply symbol-append args)))
-;; should be obsoleted by list-ref
+;; TODO: replace with list-ref
(define nth
(lambda (k lst)
(list-ref lst k)))
-;; should be obsoleted by list-tail
+;; TODO: replace with list-tail
(define nthcdr
(lambda (k lst)
(guard (err
(else #f))
(list-tail lst k))))
-;; should be obsoleted by list-copy of SRFI-1
+;; TODO: replace with list-copy of SRFI-1
(define copy-list
(lambda (lst)
(append lst '())))
+;; TODO: replace with number->string
(define digit->string
(lambda (n)
(and (number? n)
@@ -98,18 +111,20 @@
;;
;; SIOD compatibility
;;
+
+;; TODO: replace with 'display'
(define puts display)
-;; TODO: Rename to more appropriate name such as 'inspect' (the name
-;; came from debugging terms) or simply 'writeln'. But since I don't
-;; know Scheme culture enough, I can't determine what is appropriate.
+;; TODO: replace with 'writeln'
(define siod-print
(lambda (obj)
(write obj)
(newline)))
+;; TODO: replace with 'writeln'
(define print siod-print)
+;; TODO: replace with 'provided?'
(define feature?
(lambda (sym)
(provided? (symbol->string sym))))
Modified: trunk/scm/uim-module-manager.scm
==============================================================================
--- trunk/scm/uim-module-manager.scm (original)
+++ trunk/scm/uim-module-manager.scm Wed Jul 11 05:02:30 2007
@@ -72,16 +72,16 @@
;; Test if the module is valid
(if (require-module (symbol->string module))
#t
- (begin (puts (string-append "Warning: Module "
- (symbol->string module)
- " is not a correct module.\n"))
+ (begin (display (string-append "Warning: Module "
+ (symbol->string module)
+ " is not a correct module.\n"))
#f)))
(remove
(lambda (module)
(if (memq module current-module-list)
- (begin (puts (string-append "Warning: Module "
- (symbol->string module)
- " is already registered\n"))
+ (begin (display (string-append "Warning: Module "
+ (symbol->string module)
+ " is already registered\n"))
#t)
#f))
modules))
Modified: trunk/scm/uim-sh.scm
==============================================================================
--- trunk/scm/uim-sh.scm (original)
+++ trunk/scm/uim-sh.scm Wed Jul 11 05:02:30 2007
@@ -49,7 +49,7 @@
(begin
((if uim-sh-opt-strict-batch
(lambda args #f)
- print)
+ writeln)
(eval expr (interaction-environment)))
(uim-sh-loop))
#f))))
@@ -112,7 +112,7 @@
(begin
((if uim-sh-opt-strict-batch
(lambda args #f)
- print)
+ writeln)
(eval expr (interaction-environment)))
(uim-sh-loop))
#f)))))
Modified: trunk/scm/ustr.scm
==============================================================================
--- trunk/scm/ustr.scm (original)
+++ trunk/scm/ustr.scm Wed Jul 11 05:02:30 2007
@@ -234,7 +234,7 @@
(<= pos (ustr-length ustr)))
(let* ((whole (ustr-whole-seq ustr))
(latter (list-tail whole pos))
- (former (list-head whole pos)))
+ (former (take whole pos)))
(ustr-set-former-seq! ustr former)
(ustr-set-latter-seq! ustr latter)
#t)
Modified: trunk/scm/util.scm
==============================================================================
--- trunk/scm/util.scm (original)
+++ trunk/scm/util.scm Wed Jul 11 05:02:30 2007
@@ -42,6 +42,12 @@
;; generic utilities
;;
+(define writeln
+ (lambda (obj . args)
+ (let-optionals* args ((port (current-output-port)))
+ (write obj port)
+ (newline))))
+
;; Make escaped string literal to print a form.
;;
;; (string-escape "a str\n") -> "\"a str\\n\""
@@ -242,11 +248,11 @@
(lambda init-lst
(cond
((null? init-lst)
- (copy-list defaults))
+ (list-copy defaults))
;; fast path
((= (length init-lst)
(length defaults))
- (copy-list init-lst))
+ (list-copy init-lst))
;; others
((< (length init-lst)
(length defaults))
@@ -254,7 +260,7 @@
(length init-lst)))
(complemented-init-lst (append init-lst
rest-defaults)))
- (copy-list complemented-init-lst)))
+ (list-copy complemented-init-lst)))
(else
#f))))))
(eval (list 'define creator-sym creator)
Modified: trunk/test/test-custom-rt.scm
==============================================================================
--- trunk/test/test-custom-rt.scm (original)
+++ trunk/test/test-custom-rt.scm Wed Jul 11 05:02:30 2007
@@ -33,7 +33,7 @@
;;
;; custom-reload-customs
-;; These tests are passed at revision 4674 (new repository)
+;; These tests are passed at revision 4704 (new repository)
(use test.unit)
Modified: trunk/test/test-custom.scm
==============================================================================
--- trunk/test/test-custom.scm (original)
+++ trunk/test/test-custom.scm Wed Jul 11 05:02:30 2007
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; These tests are passed at revision 4674 (new repository)
+;; These tests are passed at revision 4704 (new repository)
;; TODO:
;;
Modified: trunk/test/test-ustr.scm
==============================================================================
--- trunk/test/test-ustr.scm (original)
+++ trunk/test/test-ustr.scm Wed Jul 11 05:02:30 2007
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; These tests are passed at revision 4674 (new repository)
+;; These tests are passed at revision 4704 (new repository)
(use test.unit)
Modified: trunk/test/test-util.scm
==============================================================================
--- trunk/test/test-util.scm (original)
+++ trunk/test/test-util.scm Wed Jul 11 05:02:30 2007
@@ -29,7 +29,7 @@
;;; SUCH DAMAGE.
;;;;
-;; These tests are passed at revision 4703 (new repository)
+;; These tests are passed at revision 4704 (new repository)
(use test.unit)
