[uim-commit] r1261 - in branches/r5rs: scm sigscheme uim

kzk at freedesktop.org kzk at freedesktop.org
Sun Aug 21 18:13:37 EST 2005


Author: kzk
Date: 2005-08-21 01:13:30 -0700 (Sun, 21 Aug 2005)
New Revision: 1261

Modified:
   branches/r5rs/scm/init.scm
   branches/r5rs/scm/manage-modules.scm
   branches/r5rs/scm/uim-db.scm
   branches/r5rs/scm/uim-module-manager.scm
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/io.c
   branches/r5rs/uim/uim.c
Log:
* Now we can see "gtk-entry" successfully start up!

* sigscheme/io.c
  - (ScmOp_load): not return error when file is not found.
* sigscheme/eval.c
  - (ScmExp_let, ScmExp_let_star, ScmExp_letrec): strict checking for
    let family.

* uim/uim.c
  - (uim_create_context): fix invalid use of apply.
    ScmOp_apply doesn't evaluate proc symbol.

* scm/init.scm
  - (load-user-conf): comment out temporally. because we don't have
    "verbose" procedure.

* scm/uim-db.scm
* scm/manage-modules.scm
* scm/uim-module-manager.scm
  - revert r1245's change. restore into "puts" from "print".


Modified: branches/r5rs/scm/init.scm
===================================================================
--- branches/r5rs/scm/init.scm	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/scm/init.scm	2005-08-21 08:13:30 UTC (rev 1261)
@@ -101,5 +101,5 @@
 (load-modules)
 
 (or (getenv "LIBUIM_VANILLA")
-    (load-user-conf)
+;    (load-user-conf)
     (load "default.scm"))

Modified: branches/r5rs/scm/manage-modules.scm
===================================================================
--- branches/r5rs/scm/manage-modules.scm	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/scm/manage-modules.scm	2005-08-21 08:13:30 UTC (rev 1261)
@@ -39,7 +39,7 @@
   (lambda ()
     (set! enabled-im-list
 	  (map custom-choice-rec-sym (custom-installed-im-list)))
-    (print
+    (puts
      (string-append
       ";; The described order of input methods affects which IM is preferred\n"
       ";; at the default IM selection process for each locale. i.e. list\n"
@@ -53,7 +53,7 @@
 ;; TODO: write test
 (define generate-loader-scm
   (lambda ()
-    (print
+    (puts
      (string-append
       ";; Don't edit this file manually\n"
       (string-join "\n" (stub-im-generate-all-stub-im-list))))))

Modified: branches/r5rs/scm/uim-db.scm
===================================================================
--- branches/r5rs/scm/uim-db.scm	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/scm/uim-db.scm	2005-08-21 08:13:30 UTC (rev 1261)
@@ -40,7 +40,7 @@
 
 (define uim-db-print
   (lambda (x)
-    (print "\n>>> ")
+    (puts "\n>>> ")
     (print (dbg-get-info x))
     (print x)))
 
@@ -90,7 +90,7 @@
      (lambda (l)
        (uim-db-puts "Display " (car l) ": ")
        (print (cdr l))
-       (print " ==> ")
+       (puts " ==> ")
        (*catch 'all (print (eval (cdr l) env))))
      uim-db-display)
     #t))
@@ -139,7 +139,7 @@
 	  (dbg-copy-info! (cdr code) '()) ; invalidate
 	  (dbg-copy-info! (cddr code) pos)
 	  (set-car! pos code))
-	(print "Invalid argument to uim-db-insert-code!\n"))))
+	(puts "Invalid argument to uim-db-insert-code!\n"))))
 
 (define uim-db-restore-code!
   (lambda (pos)
@@ -172,7 +172,7 @@
 	  (uim-db-breakpoint-set-next-hook-id!
 	   bp
 	   (+ 1 (uim-db-breakpoint-next-hook-id bp))))
-	(print "Invalid argument to uim-db-add-hook!\n"))))
+	(puts "Invalid argument to uim-db-add-hook!\n"))))
 
 (define uim-db-del-hook!
   (lambda (break-id hook-id)
@@ -192,8 +192,8 @@
 			     " of breakpoint "
 			     break-id
 			     "\n"))
-	      (print "Invalid hook ID.\n"))
-	  (print "Invalid breakpoint ID.\n")))))
+	      (puts "Invalid hook ID.\n"))
+	  (puts "Invalid breakpoint ID.\n")))))
 
 (define uim-db-set-break!
   (lambda criteria
@@ -221,9 +221,9 @@
 			  uim-db-breakpoint-alist))
 	      (set! uim-db-next-id (+ uim-db-next-id 1))
 	      (set! uim-db-current-file (car criteria)))
-	    (print "Error: specified code not found\n"))))
+	    (puts "Error: specified code not found\n"))))
      (else
-      (print "Usage: (uim-db-set-break! file-name line-number)\n")))))
+      (puts "Usage: (uim-db-set-break! file-name line-number)\n")))))
 
 (define uim-db-del-break!
   (lambda (id)
@@ -261,11 +261,11 @@
 			  "Type (uim-db-help 'shell) if you don't "
 			  "know what to do.\n")
 	     (uim-db-shell env bp)
-	     (print "Continuing execution.\n"))))))
+	     (puts "Continuing execution.\n"))))))
 
 (define uim-db-shell
   (lambda args
-    (print uim-db-prompt)
+    (puts uim-db-prompt)
     (let ((env (if (>= (length args) 1) (car args) ()))
 	  (bp (if (>= (length args) 2) (cadr args) #f))
 	  (expr (*catch 'all (read))))
@@ -287,7 +287,7 @@
 		  (uim-db-del-break! (eval (read))))
 		 ((@expression @expr @exp @e)
 		  (if (null? bp)
-		      (print "You can't do that in a manually-invoked shell.\n")
+		      (puts "You can't do that in a manually-invoked shell.\n")
 		      (uim-db-puts
 		       "This breakpoint is set on the expression:\n"
 		       (uim-db-breakpoint-expr bp)
@@ -304,12 +304,12 @@
 		  (uim-db-del-display! (eval (read))))
 		 ((@hook)
 		  (if (null? bp)
-		      (print "You can't do that in a manually-invoked shell.\n")
+		      (puts "You can't do that in a manually-invoked shell.\n")
 		      (uim-db-add-hook! (uim-db-breakpoint-id bp)
 					(eval (read)))))
 		 ((@unhook @delhook)
 		  (if (null? bp)
-		      (print "You can't do that in a manually-invoked shell.\n")
+		      (puts "You can't do that in a manually-invoked shell.\n")
 		      (uim-db-del-hook! (uim-db-breakpoint-id bp)
 					(eval (read)))))
 		 (else
@@ -323,8 +323,8 @@
     (uim-db-for-each
      (lambda (x)
        (case (typeof x)
-	 ((tc_string tc_symbol) (print x))
-	 ((tc_intnum) (print (number->string x)))
+	 ((tc_string tc_symbol) (puts x))
+	 ((tc_intnum) (puts (number->string x)))
 	 (else (print x))))
      args)))
 
@@ -367,12 +367,12 @@
 	       (database uim-db-help-database))
       (cond
        ((not database)
-	(print "Sorry, that topic isn't available."))
+	(puts "Sorry, that topic isn't available."))
        ((null? topics)
 	(apply uim-db-puts (cadr database))
 	(if (pair? (cddr database))
 	    (begin
-	      (print "\nSubtopics:\n")
+	      (puts "\nSubtopics:\n")
 	      (uim-db-for-each
 	       (lambda (db)
 		 (print (car db)))

Modified: branches/r5rs/scm/uim-module-manager.scm
===================================================================
--- branches/r5rs/scm/uim-module-manager.scm	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/scm/uim-module-manager.scm	2005-08-21 08:13:30 UTC (rev 1261)
@@ -39,22 +39,22 @@
    (lambda (x) ;; Test for valid module
       (if (require-module (symbol->string x))
 	  #t
-	  (begin (print (string-append "Error: Module " x " is not a correct module.\n"))
+	  (begin (puts (string-append "Error: Module " x " is not a correct module.\n"))
 		 #f)))
    (remove (lambda (x) ;; Test 
 	     (if (memq x old-module-list)
-		 (begin (print (string-append "Error : Module " x " already registered\n"))
+		 (begin (puts (string-append "Error : Module " x " already registered\n"))
 			#t)
-		 (begin ;(print (string-append "Module " x " not registered\n"))
+		 (begin ;(puts (string-append "Module " x " not registered\n"))
 		   #f)))
 	   modules)))
 
 (define (remove-unregistered-modules modules old-module-list)
   (remove (lambda (x)
 	    (if (memq x modules)
-		(begin ;(print (string-append "Error : Module " x " already registered\n"))
+		(begin ;(puts (string-append "Error : Module " x " already registered\n"))
 		       #t)
-		(begin ;(print (string-append "Module " x " not registered\n"))
+		(begin ;(puts (string-append "Module " x " not registered\n"))
 		       #f)))
 	    old-module-list))
 

Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/sigscheme/eval.c	2005-08-21 08:13:30 UTC (rev 1261)
@@ -1255,6 +1255,9 @@
     if (SCM_CONSP(bindings) || SCM_NULLP(bindings)) {
         for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
             binding = SCM_CAR(bindings);
+	    if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+		SigScm_ErrorObj("let : invalid binding form : ", binding);
+
             vars = Scm_NewCons(SCM_CAR(binding), vars);
             vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), vals);
         }
@@ -1325,6 +1328,9 @@
     if (SCM_CONSP(bindings)) {
         for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
             binding = SCM_CAR(bindings);
+	    if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+		SigScm_ErrorObj("let* : invalid binding form : ", binding);
+	    
             vars = Scm_NewCons(SCM_CAR(binding), SCM_NIL);
             vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), SCM_NIL);
 
@@ -1382,6 +1388,9 @@
     if (SCM_CONSP(bindings) || SCM_NULLP(bindings)) {
         for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
             binding = SCM_CAR(bindings);
+	    if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+		SigScm_ErrorObj("letrec : invalid binding form : ", binding);
+
             var = SCM_CAR(binding);
             val = SCM_CAR(SCM_CDR(binding));
 

Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/sigscheme/io.c	2005-08-21 08:13:30 UTC (rev 1261)
@@ -455,8 +455,13 @@
     SigScm_gc_protect_stack(&stack_start);
 
     /* sanity check */
+    /*
+      TODO : FIXME! Kazuki Ohta <mover at hct.zaq.ne.jp>
+      This should be an error, but we don't have enough error handling
+      feature.
+    */
     if (!filepath)
-	SigScm_Error("SigScm_load : no such file = %s\n", filepath);
+	return SCM_FALSE;
 
     /* open port */
     port = ScmOp_open_input_file(Scm_NewStringCopying(filepath));
@@ -479,7 +484,7 @@
     /* free str */
     free(filepath);
 
-    return SCM_UNSPECIFIED;
+    return SCM_TRUE;
 }
 
 static char* create_valid_path(const char *filename)

Modified: branches/r5rs/uim/uim.c
===================================================================
--- branches/r5rs/uim/uim.c	2005-08-21 07:26:00 UTC (rev 1260)
+++ branches/r5rs/uim/uim.c	2005-08-21 08:13:30 UTC (rev 1261)
@@ -197,10 +197,9 @@
     uim_lisp lang_   = uim_scm_make_str(lang);
     uim_lisp engine_ = uim_scm_make_str(engine);
     uim_lisp proc    = uim_scm_make_symbol("create-context");
-    uim_lisp args    = uim_scm_list3(id_, lang_, engine_);
+    uim_lisp form    = uim_scm_list4(proc, id_, lang_, engine_);
 
-    uim_scm_apply(proc, args);
-      
+    uim_scm_eval(form);
   }
 #endif  /* UIM_EVAL_SEXP_AS_STRING */
   return uc;



More information about the uim-commit mailing list