Revision: 6550
Author: [email protected]
Date: Tue Jul 20 03:49:16 2010
Log: * uim/fileio.c (c_file_position_whence, c_file_position_set):
* scm/fileio.scm (file-position):
- New function.
* uim/fileio.c (uim_plugin_instance_init, uim_plugin_instance_quit):
- Add scheme function (file-position-set!) and (file-position-whence?).
http://code.google.com/p/uim/source/detail?r=6550
Modified:
/trunk/scm/fileio.scm
/trunk/uim/fileio.c
=======================================
--- /trunk/scm/fileio.scm Thu May 6 09:38:31 2010
+++ /trunk/scm/fileio.scm Tue Jul 20 03:49:16 2010
@@ -37,6 +37,7 @@
(define file-open-flags-alist (file-open-flags?))
(define file-open-mode-alist (file-open-mode?))
+(define file-position-whence-alist (file-position-whence?))
(define file-poll-flags-alist (file-poll-flags?))
(define (file-set-flag l alist)
@@ -51,6 +52,9 @@
(define (file-poll-flags-number l)
(file-set-flag l file-poll-flags-alist))
+(define (file-position field)
+ (file-position-set! field 0 (assq-cdr '$SEEK_CUR
file-position-whence-alist)))
+
(define (string->file-buf str)
(string->list str))
(define (file-buf->string buf)
@@ -63,6 +67,42 @@
(define (file-write-string s str)
(file-write s (string->file-buf str)))
+(define (file-read-string-with-terminate-char socket term-char)
+ (let loop ((c (file-read socket 1))
+ (rest '()))
+ (cond ((eof-object? c)
+ (uim-notify-fatal (N_ "unexpected terminate string."))
+ "")
+ ((eq? (car c) term-char)
+ (file-buf->string (reverse rest)))
+ (else
+ (loop (file-read socket 1) (cons (car c) rest))))))
+
+(define (file-read-string-with-terminate-chars socket term-chars)
+ (let ((buf (file-read socket (length term-chars))))
+ (cond ((eof-object? buf)
+ (raise (N_ "unexpected terminate string.")))
+ ((equal? term-chars buf)
+ "")
+ (else
+ (let loop ((c (file-read socket 1))
+ (buf buf)
+ (rest '()))
+ (cond ((eof-object? c)
+ (raise (N_ "unexpected terminate string.")))
+ ((equal? term-chars (append (cdr buf) c))
+ (file-buf->string (append rest (list (car buf)))))
+ (else
+ ;; enqueue
+ (loop (file-read socket 1)
+ (append (cdr buf) c)
+ (append rest (list (car buf)))))))))))
+
+(define (file-read-string-with-terminate socket term-char)
+ (if (char? term-char)
+ (file-read-string-with-terminate-char socket term-char)
+ (file-read-string-with-terminate-chars socket term-char)))
+
(define-record-type file-port
(make-file-port context fd inbufsiz inbuf read write) file-port?
(context context? context!)
=======================================
--- /trunk/uim/fileio.c Sun Apr 4 20:35:54 2010
+++ /trunk/uim/fileio.c Tue Jul 20 03:49:16 2010
@@ -228,6 +228,33 @@
return ret_;
}
+const static opt_args position_whence[] = {
+ { SEEK_SET, "$SEEK_SET" },
+ { SEEK_CUR, "$SEEK_CUR" },
+ { SEEK_END, "$SEEK_END" },
+ { 0, 0 }
+};
+
+static uim_lisp uim_lisp_position_whence;
+static uim_lisp
+c_file_position_whence(void)
+{
+ return uim_lisp_position_whence;
+}
+
+static uim_lisp
+c_file_position_set(uim_lisp fildes_, uim_lisp offset_, uim_lisp whence_)
+{
+ int ret = 0;
+
+ ret = lseek(C_INT(fildes_), C_INT(offset_), C_INT(whence_));
+ if (ret == -1) {
+ uim_lisp err_ = LIST3(fildes_, offset_, whence_);
+ ERROR_OBJ(strerror(errno), err_);
+ }
+ return MAKE_INT(ret);
+}
+
static uim_lisp
c_duplicate2_fileno(uim_lisp oldd_, uim_lisp newd_)
{
@@ -351,6 +378,11 @@
uim_scm_init_proc1("file-close", c_file_close);
uim_scm_init_proc2("file-read", c_file_read);
uim_scm_init_proc2("file-write", c_file_write);
+ uim_scm_init_proc3("file-position-set!", c_file_position_set);
+ uim_scm_init_proc0("file-position-whence?", c_file_position_whence);
+ uim_lisp_position_whence = make_arg_list(position_whence);
+ uim_scm_gc_protect(&uim_lisp_position_whence);
+
uim_scm_init_proc2("duplicate2-fileno", c_duplicate2_fileno);
uim_scm_init_proc2("file-poll", c_file_poll);
@@ -366,5 +398,6 @@
{
uim_scm_gc_unprotect(&uim_lisp_open_flags);
uim_scm_gc_unprotect(&uim_lisp_open_mode);
+ uim_scm_gc_unprotect(&uim_lisp_position_whence);
uim_scm_gc_unprotect(&uim_lisp_poll_flags);
}
