summaryrefslogtreecommitdiff
path: root/ext/tcltklib
diff options
context:
space:
mode:
authornagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2003-08-29 08:34:14 +0000
committernagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>2003-08-29 08:34:14 +0000
commit24ff3f444882ba60418a6736d6c5d57ba3c0b80c (patch)
tree813a69918ff8435617ca58e193f9440c06febdb7 /ext/tcltklib
parent22a5aec4b322c1be9eced78967e5cfd0ae54b6cb (diff)
* doc/ChangeLog-1.8.0: add changes of Ruby/Tk
* ext/tcltklib/tcltklib.c : some methods have no effect if on slave-IP * ext/tcltklib/tcltklib.c : can create a interpreter without Tk * ext/tcltklib/tcltklib.c : bug fix on handling exceptions * ext/tcltklib/MANUAL.euc : modify * ext/tk/lib/tk.rb : freeze some core modules * ext/tk/lib/multi-tk.rb : more secure * ext/tk/lib/tk.rb: TkVariable.new(array) --> treat the array as the Tk's list * ext/tk/lib/tk.rb: improve accessibility of TkVariable object * ext/tk/lib/tk.rb, ext/tk/lib/tkfont.rb, ext/tk/lib/tkcanvas.rb, ext/tk/lib/tktext.rb : fix bug of font handling * ext/tk/lib/tkfont.rb TkFont.new() accepts compound fonts * process.c: bug fix * process.c: add rb_secure(2) to methods of Process::{UID,GID,Sys} * process.c: deny handling IDs during evaluating the block given to the Process::{UID,GID}.switch method git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4456 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext/tcltklib')
-rw-r--r--ext/tcltklib/MANUAL.euc40
-rw-r--r--ext/tcltklib/tcltklib.c304
2 files changed, 289 insertions, 55 deletions
diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc
index 30cfd8c1070..f04d036c64b 100644
--- a/ext/tcltklib/MANUAL.euc
+++ b/ext/tcltklib/MANUAL.euc
@@ -1,5 +1,5 @@
(tof)
- 2003/07/25 Hidetoshi NAGAI
+ 2003/08/07 Hidetoshi NAGAI
本ドキュメントには古い tcltk ライブラリ,tcltklib ライブラリの説明
が含まれていますが,その記述内容は古いものとなっています.
@@ -263,6 +263,12 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: Tk インタープリタ上で例外を発生した際に,イベントループをエ
: ラー停止させるかどうかの設定状態を true/false で得る.
+ num_of_mainwindows
+ : 現在のメインウィンドウ (ルートウィジェット) の数を返す.
+ : メインウィンドウは一つのインタープリタに付き最大一つである
+ : ので,この値は現在 Tk の機能が有効であるインタープリタの総
+ : 数に等しい.
+
クラス TclTkIp
クラスメソッド
@@ -274,6 +280,11 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
: 引数として与えるオプションと同様の情報を文字列として与える.
: 与えられた情報は,root widget 生成の際に用いられる.
: ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
+ : もし options に敢えて nil または false を与えた場合,Tk ライ
+ : ブラリが導入されていない (つまりは Tcl のみの) インタープリ
+ : タを生成する.この場合は GUI 環境は必要ないため,ウインドウ
+ : システムが存在しない,または使用できない環境でも Tcl インター
+ : プリタを生成し,Tcl やその拡張ライブラリを活用することができる.
インスタンスメソッド
create_slave(name, safe=false)
@@ -331,17 +342,26 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
_return_value
: 直前の Tcl/Tk 上での評価の実行結果としての戻り値を返す.
- mainloop : 引数を含めて TclTkLib.mainloop に同じ
- mainloop_watchdog : 引数を含めて TclTkLib.mainloop_watchdog に同じ
- do_one_event : 引数を含めて TclTkLib.do_one_event に同じ
- set_eventloop_tick : 引数を含めて TclTkLib.set_eventloop_tick に同じ
- get_eventloop_tick : 引数を含めて TclTkLib.get_eventloop_tick に同じ
- set_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ
- get_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ
+ mainloop
+ mainloop_watchdog
+ : スレーブ IP の場合にはイベントループを起動せずに nil を返す.
+ : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ.
+
+ do_one_event
+ : スレーブ IP の場合には引数のイベントフラグに DONT_WAIT が
+ : 強制的に追加される (イベント待ちでスリープすることは禁止).
+ : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ.
+
+ set_eventloop_tick
+ get_eventloop_tick
+ set_no_event_wait
+ get_no_event_wait
+ set_eventloop_weight
+ get_eventloop_weight
mainloop_abort_on_exception
- : 引数を含めて TclTkLib.mainloop_abort_on_exception に同じ
mainloop_abort_on_exception=
- : 引数を含めて TclTkLib.mainloop_abort_on_exception= に同じ
+ : スレーブ IP の場合には値の設定が許されない (無視される).
+ : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ.
クラス TkCallbackBreak < StandardError
クラス TkCallbackContinue < StandardError
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index ec00cea217c..cb2036296ac 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -8,6 +8,13 @@
#include "rubysig.h"
#undef EXTERN /* avoid conflict with tcl.h of tcl8.2 or before */
#include <stdio.h>
+#ifdef HAVE_STDARG_PROTOTYPES
+#include <stdarg.h>
+#define va_init_list(a,b) va_start(a,b)
+#else
+#include <varargs.h>
+#define va_init_list(a,b) va_start(a)
+#endif
#include <string.h>
#include <tcl.h>
#include <tk.h>
@@ -93,6 +100,25 @@ static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
static int ip_ruby _((ClientData, Tcl_Interp *, int, char **));
#endif
+/*---- class TclTkIp ----*/
+struct tcltkip {
+ Tcl_Interp *ip; /* the interpreter */
+ int return_value; /* return value */
+};
+
+static struct tcltkip *
+get_ip(self)
+ VALUE self;
+{
+ struct tcltkip *ptr;
+
+ Data_Get_Struct(self, struct tcltkip, ptr);
+ if (ptr == 0) {
+ rb_raise(rb_eTypeError, "uninitialized TclTkIp");
+ }
+ return ptr;
+}
+
/* Tk_ThreadTimer */
static Tcl_TimerToken timer_token = (Tcl_TimerToken)NULL;
@@ -156,6 +182,27 @@ get_eventloop_tick(self)
}
static VALUE
+ip_set_eventloop_tick(self, tick)
+ VALUE self;
+ VALUE tick;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return get_eventloop_tick(self);
+ }
+ return set_eventloop_tick(self, tick);
+}
+
+static VALUE
+ip_get_eventloop_tick(self)
+ VALUE self;
+{
+ return get_eventloop_tick(self);
+}
+
+static VALUE
set_no_event_wait(self, wait)
VALUE self;
VALUE wait;
@@ -180,6 +227,27 @@ get_no_event_wait(self)
}
static VALUE
+ip_set_no_event_wait(self, wait)
+ VALUE self;
+ VALUE wait;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return get_no_event_wait(self);
+ }
+ return set_no_event_wait(self, wait);
+}
+
+static VALUE
+ip_get_no_event_wait(self)
+ VALUE self;
+{
+ return get_no_event_wait(self);
+}
+
+static VALUE
set_eventloop_weight(self, loop_max, no_event)
VALUE self;
VALUE loop_max;
@@ -206,7 +274,29 @@ get_eventloop_weight(self)
}
static VALUE
-rb_evloop_abort_on_exc(self)
+ip_set_eventloop_weight(self, loop_max, no_event)
+ VALUE self;
+ VALUE loop_max;
+ VALUE no_event;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return get_eventloop_weight(self);
+ }
+ return set_eventloop_weight(self, loop_max, no_event);
+}
+
+static VALUE
+ip_get_eventloop_weight(self)
+ VALUE self;
+{
+ return get_eventloop_weight(self);
+}
+
+static VALUE
+lib_evloop_abort_on_exc(self)
VALUE self;
{
if (event_loop_abort_on_exc > 0) {
@@ -219,7 +309,14 @@ rb_evloop_abort_on_exc(self)
}
static VALUE
-rb_evloop_abort_on_exc_set(self, val)
+ip_evloop_abort_on_exc(self)
+ VALUE self;
+{
+ return lib_evloop_abort_on_exc(self);
+}
+
+static VALUE
+lib_evloop_abort_on_exc_set(self, val)
VALUE self, val;
{
rb_secure(4);
@@ -230,7 +327,27 @@ rb_evloop_abort_on_exc_set(self, val)
} else {
event_loop_abort_on_exc = 0;
}
- return rb_evloop_abort_on_exc(self);
+ return lib_evloop_abort_on_exc(self);
+}
+
+static VALUE
+ip_evloop_abort_on_exc_set(self, val)
+ VALUE self, val;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return lib_evloop_abort_on_exc(self);
+ }
+ return lib_evloop_abort_on_exc_set(self, val);
+}
+
+static VALUE
+lib_num_of_mainwindows(self)
+ VALUE self;
+{
+ return INT2FIX(Tk_GetNumMainWindows());
}
VALUE
@@ -379,6 +496,21 @@ lib_mainloop(argc, argv, self)
return lib_mainloop_launcher(check_rootwidget);
}
+static VALUE
+ip_mainloop(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return Qnil;
+ }
+ return lib_mainloop(argc, argv, self);
+}
+
VALUE
lib_watchdog_core(check_rootwidget)
VALUE check_rootwidget;
@@ -464,10 +596,26 @@ lib_mainloop_watchdog(argc, argv, self)
}
static VALUE
-lib_do_one_event(argc, argv, self)
+ip_mainloop_watchdog(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return Qnil;
+ }
+ return lib_mainloop_watchdog(argc, argv, self);
+}
+
+static VALUE
+lib_do_one_event_core(argc, argv, self, is_ip)
int argc;
VALUE *argv;
VALUE self;
+ int is_ip;
{
VALUE vflags;
int flags;
@@ -479,6 +627,16 @@ lib_do_one_event(argc, argv, self)
Check_Type(vflags, T_FIXNUM);
flags = FIX2INT(vflags);
}
+
+ if (is_ip) {
+ /* check IP */
+ struct tcltkip *ptr = get_ip(self);
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ flags |= TCL_DONT_WAIT;
+ }
+ }
+
ret = Tcl_DoOneEvent(flags);
if (ret) {
return Qtrue;
@@ -487,25 +645,25 @@ lib_do_one_event(argc, argv, self)
}
}
-/*---- class TclTkIp ----*/
-struct tcltkip {
- Tcl_Interp *ip; /* the interpreter */
- int return_value; /* return value */
-};
-
-static struct tcltkip *
-get_ip(self)
+static VALUE
+lib_do_one_event(argc, argv, self)
+ int argc;
+ VALUE *argv;
VALUE self;
{
- struct tcltkip *ptr;
+ return lib_do_one_event_core(argc, argv, self, 0);
+}
- Data_Get_Struct(self, struct tcltkip, ptr);
- if (ptr == 0) {
- rb_raise(rb_eTypeError, "uninitialized TclTkIp");
- }
- return ptr;
+static VALUE
+ip_do_one_event(argc, argv, self)
+ int argc;
+ VALUE *argv;
+ VALUE self;
+{
+ return lib_do_one_event_core(argc, argv, self, 0);
}
+
/* Tcl command `ruby' */
static VALUE
ip_eval_rescue(failed, einfo)
@@ -551,6 +709,19 @@ lib_restart(self)
return Qnil;
}
+static VALUE
+ip_restart(self)
+ VALUE self;
+{
+ struct tcltkip *ptr = get_ip(self);
+
+ if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
+ /* slave IP */
+ return Qnil;
+ }
+ return lib_restart(self);
+}
+
static int
#if TCL_MAJOR_VERSION >= 8
ip_ruby(clientData, interp, argc, argv)
@@ -651,6 +822,7 @@ ip_init(argc, argv, self)
struct tcltkip *ptr; /* tcltkip data struct */
VALUE argv0, opts;
int cnt;
+ int with_tk = 1;
/* create object */
Data_Get_Struct(self, struct tcltkip, ptr);
@@ -675,7 +847,12 @@ ip_init(argc, argv, self)
switch(cnt) {
case 2:
/* options */
- Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
+ if (opts == Qnil || opts == Qfalse) {
+ /* without Tk */
+ with_tk = 0;
+ } else {
+ Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
+ }
case 1:
/* argv0 */
if (argv0 != Qnil) {
@@ -687,17 +864,19 @@ ip_init(argc, argv, self)
}
/* from Tcl_AppInit() */
- DUMP1("Tk_Init");
- if (Tk_Init(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
- }
- DUMP1("Tcl_StaticPackage(\"Tk\")");
+ if (with_tk) {
+ DUMP1("Tk_Init");
+ if (Tk_Init(ptr->ip) == TCL_ERROR) {
+ rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ }
+ DUMP1("Tcl_StaticPackage(\"Tk\")");
#if TCL_MAJOR_VERSION >= 8
- Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit);
+ Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit);
#else
- Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
- (Tcl_PackageInitProc *) NULL);
+ Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
+ (Tcl_PackageInitProc *) NULL);
#endif
+ }
/* add ruby command to the interpreter */
#if TCL_MAJOR_VERSION >= 8
@@ -901,6 +1080,32 @@ ip_fromUTF8(self, str, encodename)
static VALUE
+#ifdef HAVE_STDARG_PROTOTYPES
+create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...)
+#else
+create_ip_exc(interp, exc, fmt, va_alist)
+ VALUE interp:
+ VALUE exc;
+ const char *fmt;
+ va_dcl
+#endif
+{
+ va_list args;
+ char buf[BUFSIZ];
+ VALUE einfo;
+
+ va_init_list(args,fmt);
+ vsnprintf(buf, BUFSIZ, fmt, args);
+ buf[BUFSIZ - 1] = '\0';
+ va_end(args);
+ einfo = rb_exc_new2(exc, buf);
+ rb_iv_set(einfo, "interp", interp);
+ Tcl_ResetResult(get_ip(interp)->ip);
+ return einfo;
+}
+
+
+static VALUE
ip_invoke_real(argc, argv, obj)
int argc;
VALUE *argv;
@@ -934,7 +1139,9 @@ ip_invoke_real(argc, argv, obj)
if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
/* if (event_loop_abort_on_exc || cmd[0] != '.') { */
if (event_loop_abort_on_exc > 0) {
- rb_raise(rb_eNameError, "invalid command name `%s'", cmd);
+ /*rb_ip_raise(obj, rb_eNameError, "invalid command name `%s'", cmd);*/
+ return create_ip_exc(obj, rb_eNameError,
+ "invalid command name `%s'", cmd);
} else {
if (event_loop_abort_on_exc < 0) {
rb_warning("invalid command name `%s' (ignore)", cmd);
@@ -1021,7 +1228,8 @@ ip_invoke_real(argc, argv, obj)
/* exception on mainloop */
if (ptr->return_value == TCL_ERROR) {
if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) {
- rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+ /*rb_ip_raise(obj, rb_eRuntimeError, "%s", ptr->ip->result);*/
+ return create_ip_exc(obj, rb_eRuntimeError, "%s", ptr->ip->result);
} else {
if (event_loop_abort_on_exc < 0) {
rb_warning("%s (ignore)", ptr->ip->result);
@@ -1137,6 +1345,9 @@ ip_invoke(argc, argv, obj)
/* get result & free allocated memory */
result = *alloc_result;
+ if (rb_obj_is_kind_of(result, rb_eException)) {
+ rb_exc_raise(result);
+ }
free(alloc_argv);
free(alloc_result);
@@ -1197,6 +1408,10 @@ Init_tcltklib()
rb_define_module_function(lib, "mainloop_watchdog",
lib_mainloop_watchdog, -1);
rb_define_module_function(lib, "do_one_event", lib_do_one_event, -1);
+ rb_define_module_function(lib, "mainloop_abort_on_exception",
+ lib_evloop_abort_on_exc, 0);
+ rb_define_module_function(lib, "mainloop_abort_on_exception=",
+ lib_evloop_abort_on_exc_set, 1);
rb_define_module_function(lib, "set_eventloop_tick",set_eventloop_tick,1);
rb_define_module_function(lib, "get_eventloop_tick",get_eventloop_tick,0);
rb_define_module_function(lib, "set_no_event_wait", set_no_event_wait, 1);
@@ -1205,10 +1420,8 @@ Init_tcltklib()
set_eventloop_weight, 2);
rb_define_module_function(lib, "get_eventloop_weight",
get_eventloop_weight, 0);
- rb_define_module_function(lib, "mainloop_abort_on_exception",
- rb_evloop_abort_on_exc, 0);
- rb_define_module_function(lib, "mainloop_abort_on_exception=",
- rb_evloop_abort_on_exc_set, 1);
+ rb_define_module_function(lib, "num_of_mainwindows",
+ lib_num_of_mainwindows, 0);
rb_define_alloc_func(ip, ip_alloc);
rb_define_method(ip, "initialize", ip_init, -1);
@@ -1222,20 +1435,21 @@ Init_tcltklib()
rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
rb_define_method(ip, "_invoke", ip_invoke, -1);
rb_define_method(ip, "_return_value", ip_retval, 0);
- rb_define_method(ip, "mainloop", lib_mainloop, -1);
- rb_define_method(ip, "mainloop_watchdog", lib_mainloop_watchdog, -1);
- rb_define_method(ip, "do_one_event", lib_do_one_event, -1);
+
+ rb_define_method(ip, "mainloop", ip_mainloop, -1);
+ rb_define_method(ip, "mainloop_watchdog", ip_mainloop_watchdog, -1);
+ rb_define_method(ip, "do_one_event", ip_do_one_event, -1);
rb_define_method(ip, "mainloop_abort_on_exception",
- rb_evloop_abort_on_exc, 0);
+ ip_evloop_abort_on_exc, 0);
rb_define_method(ip, "mainloop_abort_on_exception=",
- rb_evloop_abort_on_exc_set, 1);
- rb_define_method(ip, "set_eventloop_tick", set_eventloop_tick, 1);
- rb_define_method(ip, "get_eventloop_tick", get_eventloop_tick, 0);
- rb_define_method(ip, "set_no_event_wait", set_no_event_wait, 1);
- rb_define_method(ip, "get_no_event_wait", get_no_event_wait, 0);
- rb_define_method(ip, "set_eventloop_weight", set_eventloop_weight, 2);
- rb_define_method(ip, "get_eventloop_weight", get_eventloop_weight, 0);
- rb_define_method(ip, "restart", lib_restart, 0);
+ ip_evloop_abort_on_exc_set, 1);
+ rb_define_method(ip, "set_eventloop_tick", ip_set_eventloop_tick, 1);
+ rb_define_method(ip, "get_eventloop_tick", ip_get_eventloop_tick, 0);
+ rb_define_method(ip, "set_no_event_wait", ip_set_no_event_wait, 1);
+ rb_define_method(ip, "get_no_event_wait", ip_get_no_event_wait, 0);
+ rb_define_method(ip, "set_eventloop_weight", ip_set_eventloop_weight, 2);
+ rb_define_method(ip, "get_eventloop_weight", ip_get_eventloop_weight, 0);
+ rb_define_method(ip, "restart", ip_restart, 0);
eventloop_thread = 0;
watchdog_thread = 0;