From 8b8799716011d476badeda51ff876f698f59c5e0 Mon Sep 17 00:00:00 2001 From: nagai Date: Tue, 6 Dec 2005 16:05:50 +0000 Subject: * ext/tk/README.macosx-aqua: [new document] tips to avoid the known bug on platform specific dialogs of Tcl/Tk Aqua on MacOS X. * ext/tk/tcltklib.c: fix bug on switching threads and waiting on the deleted interpreter on vwait and tkwait command. * ext/tk/lib/multi-tk.rb: kill the meaningless loop for the deleted Tk interpreter. * ext/tk/sample/demos-jp/image3.rb: [bug fix] wrong argument. * ext/tk/sample/demos-en/image3.rb: ditto. * ext/tk/sample/demos-jp/menu.rb: fix message for MacOS X. * ext/tk/sample/demos-jp/menu8x.rb: ditto. * ext/tk/sample/demos-en/menu.rb: ditto. * ext/tk/sample/demos-jp/widget; update version-info. * ext/tk/sample/demos-en/widget; ditto. git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_8@9650 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tk/README.macosx-aqua | 67 ++++++++++++++++++++++ ext/tk/lib/multi-tk.rb | 1 + ext/tk/sample/demos-en/image3.rb | 3 +- ext/tk/sample/demos-en/widget | 2 +- ext/tk/sample/demos-jp/image3.rb | 3 +- ext/tk/sample/demos-jp/menu.rb | 12 +++- ext/tk/sample/demos-jp/menu8x.rb | 12 +++- ext/tk/sample/demos-jp/widget | 2 +- ext/tk/tcltklib.c | 119 +++++++++++++++++++++++++++++---------- 9 files changed, 182 insertions(+), 39 deletions(-) create mode 100644 ext/tk/README.macosx-aqua (limited to 'ext/tk') diff --git a/ext/tk/README.macosx-aqua b/ext/tk/README.macosx-aqua new file mode 100644 index 0000000000..25a8ed827c --- /dev/null +++ b/ext/tk/README.macosx-aqua @@ -0,0 +1,67 @@ + + *** for MacOS X Aqua (Tcl/Tk Aqua) users *** + +First of all, please read README.tcltklib to use Tcl/Tk Aqua Framework. + +With Tcl/Tk Aqua libraries, current tcltklib somtimes freezes when +using Aqua specific dialogs (e.g. Tk.messageBox). +This is a known bug of Ruby-1.8.4 release. + +When you meet the trouble on your GUI, you'll be able to avoid the trouble +by Tcl/Tk's traditional dialogs. +If you want to do that, please call some of the following bits of script +after "reqruie 'tk'". + +================================================================= +# use a traditional dialog for Tk.chooseColor() +Tk.ip_eval(<<'EOS') + proc ::tk_chooseColor {args} { + return [eval tk::dialog::color:: $args] + } +EOS + +# use a traditional dialog for Tk.getOpenFile() and Tk.getMultipleOpenFile() +Tk.ip_eval(<<'EOS') + proc ::tk_getOpenFile {args} { + if {$::tk_strictMotif} { + return [eval tk::MotifFDialog open $args] + } else { + return [eval ::tk::dialog::file:: open $args] + } + } +EOS + +# use a traditional dialog for Tk.getSaveFile() and Tk.getMultipleSaveFile() +Tk.ip_eval(<<'EOS') + proc ::tk_getSaveFile {args} { + if {$::tk_strictMotif} { + return [eval tk::MotifFDialog save $args] + } else { + return [eval ::tk::dialog::file:: save $args] + } + } +EOS + +# use a traditional dialog for Tk.messageBox() +Tk.ip_eval(<<'EOS') + proc ::tk_messageBox {args} { + return [eval tk::MessageBox $args] + } +EOS + +# use a traditional dialog for Tk.chooseDirectory() +Tk.ip_eval(<<'EOS') + proc ::tk_chooseDirectory {args} { + return [eval ::tk::dialog::file::chooseDir:: $args] + } +EOS +================================================================= + +Each of them replaces the platform specific dialog command to the +traditional one. + +If you use some MultiTkIp objects, probably, you'll have to call the +bits of script for each MultiTkIp object. + +-- +Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp) diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb index b5ef77c14d..a022a5c626 100644 --- a/ext/tk/lib/multi-tk.rb +++ b/ext/tk/lib/multi-tk.rb @@ -603,6 +603,7 @@ class MultiTkIp begin loop do sleep 1 + receiver.kill if @interp.deleted? break unless receiver.alive? end rescue Exception diff --git a/ext/tk/sample/demos-en/image3.rb b/ext/tk/sample/demos-en/image3.rb index d77cc0f99c..e46d3796f2 100644 --- a/ext/tk/sample/demos-en/image3.rb +++ b/ext/tk/sample/demos-en/image3.rb @@ -35,7 +35,8 @@ end # Arguments: # w - Name of the toplevel window of the demo. def selectAndLoadDir(w, lbox) - dir = Tk.chooseDirectory(:initialdir=>$dirName, :parent=>w, :mustexist=>true) + dir = Tk.chooseDirectory(:initialdir=>$dirName.value, + :parent=>w, :mustexist=>true) if dir.length > 0 $dirName.value = dir loadDir(lbox) diff --git a/ext/tk/sample/demos-en/widget b/ext/tk/sample/demos-en/widget index 4f841b9c48..cb60bc86ea 100644 --- a/ext/tk/sample/demos-en/widget +++ b/ext/tk/sample/demos-en/widget @@ -812,7 +812,7 @@ end # def aboutBox Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo', - 'message'=>"Ruby/Tk widget demonstration Ver.1.5.5-en\n\n" + + 'message'=>"Ruby/Tk widget demonstration Ver.1.5.6-en\n\n" + "based on demos of Tk8.1 -- 8.5 " + "( Copyright:: " + "(c) 1996-1997 Sun Microsystems, Inc. / " + diff --git a/ext/tk/sample/demos-jp/image3.rb b/ext/tk/sample/demos-jp/image3.rb index 549152514b..d9f378c116 100644 --- a/ext/tk/sample/demos-jp/image3.rb +++ b/ext/tk/sample/demos-jp/image3.rb @@ -35,7 +35,8 @@ end # Arguments: # w - Name of the toplevel window of the demo. def selectAndLoadDir3(w, lbox) - dir = Tk.chooseDirectory(:initialdir=>$dirName, :parent=>w, :mustexist=>true) + dir = Tk.chooseDirectory(:initialdir=>$dirName.value, + :parent=>w, :mustexist=>true) if dir.length > 0 $dirName.value = dir loadDir3(lbox) diff --git a/ext/tk/sample/demos-jp/menu.rb b/ext/tk/sample/demos-jp/menu.rb index 50152cead3..add85f7f7b 100644 --- a/ext/tk/sample/demos-jp/menu.rb +++ b/ext/tk/sample/demos-jp/menu.rb @@ -19,9 +19,16 @@ $menu_demo = TkToplevel.new {|w| $menu_frame = TkFrame.new($menu_demo, 'relief'=>'raised', 'bd'=>2) $menu_frame.pack('side'=>'top', 'fill'=>'x') +begin + windowingsystem = Tk.windowingsystem() +rescue + windowingsystem = "" +end + # label 生成 TkLabel.new($menu_demo,'font'=>$font,'wraplength'=>'4i','justify'=>'left') { - if $tk_platform['platform'] == 'macintosh' + if $tk_platform['platform'] == 'macintosh' || + windowingsystem == "classic" || windowingsystem == "aqua" text("このウィンドウは様々なメニューとカスケードメニューから構成されています。Command-X を入力すると、Xがコマンドキー記号に続いて表示されている文字ならば、アクセラレータを使った項目起動を行うことができます。メニュー要素中、最後のものは、そのメニューの最初の項目を選択することで独立させることができます。") else text("このウィンドウは様々なメニューとカスケードメニューから構成されています。Alt-X を入力すると、Xがメニューにアンダーライン付きで表示されている文字ならば、キーボードからの指定ができます。矢印キーでメニューのトラバースも可能です。メニューが指定された際には、スペースキーで実行することができます。あるいは、アンダーライン付きの文字を入力することでも実行できます。メニューのエントリがアクセラレータを持っている場合は、そのアクセラレータを入力することでメニューを指定することなしに実行することができます。メニュー要素中、最後のものは、そのメニューの最初の項目を選択することで独立させることができます。") @@ -63,7 +70,8 @@ TkMenubutton.new($menu_frame, 'text'=>'File', 'underline'=>0) {|m| } } -if $tk_platform['platform'] == 'macintosh' +if $tk_platform['platform'] == 'macintosh' || + windowingsystem == "classic" || windowingsystem == "aqua" modifier = 'Command' elsif $tk_platform['platform'] == 'windows' modifier = 'Control' diff --git a/ext/tk/sample/demos-jp/menu8x.rb b/ext/tk/sample/demos-jp/menu8x.rb index ab691a42b5..050f0decb4 100644 --- a/ext/tk/sample/demos-jp/menu8x.rb +++ b/ext/tk/sample/demos-jp/menu8x.rb @@ -43,9 +43,16 @@ TkFrame.new($menu8x_demo) {|frame| else ; # Tk8.x +begin + windowingsystem = Tk.windowingsystem() +rescue + windowingsystem = "" +end + # label 生成 TkLabel.new($menu8x_demo,'font'=>$font,'wraplength'=>'4i','justify'=>'left') { - if $tk_platform['platform'] == 'macintosh' + if $tk_platform['platform'] == 'macintosh' || + windowingsystem == "classic" || windowingsystem == "aqua" text("このウィンドウは様々なメニューとカスケードメニューから構成されています。Command-X を入力すると、Xがコマンドキー記号に続いて表示されている文字ならば、アクセラレータを使った項目起動を行うことができます。メニュー要素中、最後のものは、そのメニューの最初の項目を選択することで独立させることができます。") else text("このウィンドウは様々なメニューとカスケードメニューから構成されています。Alt-X を入力すると、Xがメニューにアンダーライン付きで表示されている文字ならば、キーボードからの指定ができます。矢印キーでメニューのトラバースも可能です。メニューが指定された際には、スペースキーで実行することができます。あるいは、アンダーライン付きの文字を入力することでも実行できます。メニューのエントリがアクセラレータを持っている場合は、そのアクセラレータを入力することでメニューを指定することなしに実行することができます。メニュー要素中、最後のものは、そのメニューの最初の項目を選択することで独立させることができます。") @@ -93,7 +100,8 @@ TkMenu.new($menu8x_demo, 'tearoff'=>false) {|m| add('command', 'label'=>'終了', 'command'=>proc{$menu8x_demo.destroy}) } - if $tk_platform['platform'] == 'macintosh' + if $tk_platform['platform'] == 'macintosh' || + windowingsystem == "classic" || windowingsystem == "aqua" modifier = 'Command' elsif $tk_platform['platform'] == 'windows' modifier = 'Control' diff --git a/ext/tk/sample/demos-jp/widget b/ext/tk/sample/demos-jp/widget index 070e513dc1..2156f841b7 100644 --- a/ext/tk/sample/demos-jp/widget +++ b/ext/tk/sample/demos-jp/widget @@ -842,7 +842,7 @@ end # def aboutBox Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo', - 'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.5-jp\n\n" + + 'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.6-jp\n\n" + "based on demos of Tk8.1 -- 8.5 " + "( Copyright:: " + "(c) 1996-1997 Sun Microsystems, Inc. / " + diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c index 74eb500294..a4a0d20ca5 100644 --- a/ext/tk/tcltklib.c +++ b/ext/tk/tcltklib.c @@ -1271,10 +1271,11 @@ eventloop_sleep(dummy) static int -lib_eventloop_core(check_root, update_flag, check_var) +lib_eventloop_core(check_root, update_flag, check_var, interp) int check_root; int update_flag; int *check_var; + Tcl_Interp *interp; { volatile VALUE current = eventloop_thread; int found_event = 1; @@ -1324,6 +1325,11 @@ lib_eventloop_core(check_root, update_flag, check_var) if (*check_var || !found_event) { return found_event; } + if (interp != (Tcl_Interp*)NULL + && Tcl_InterpDeleted(interp)) { + /* IP for check_var is deleted */ + return 0; + } } /* found_event = Tcl_DoOneEvent(event_flag); */ @@ -1435,6 +1441,11 @@ lib_eventloop_core(check_root, update_flag, check_var) if (*check_var || !found_event) { return found_event; } + if (interp != (Tcl_Interp*)NULL + && Tcl_InterpDeleted(interp)) { + /* IP for check_var is deleted */ + return 0; + } } if (NIL_P(eventloop_thread) || current == eventloop_thread) { @@ -1611,6 +1622,8 @@ struct evloop_params { int check_root; int update_flag; int *check_var; + Tcl_Interp *interp; + int thr_crit_bup; }; VALUE @@ -1623,7 +1636,8 @@ lib_eventloop_main_core(args) if (lib_eventloop_core(params->check_root, params->update_flag, - params->check_var)) { + params->check_var, + params->interp)) { return Qtrue; } else { return Qfalse; @@ -1676,6 +1690,9 @@ lib_eventloop_ensure(args) DUMP2("eventloop_ensure: eventloop-thread : %lx", eventloop_thread); if (eventloop_thread != current_evloop) { DUMP2("finish eventloop %lx (NOT current eventloop)", current_evloop); + + rb_thread_critical = ptr->thr_crit_bup; + return Qnil; } @@ -1706,15 +1723,18 @@ lib_eventloop_ensure(args) free(ptr); + rb_thread_critical = ptr->thr_crit_bup; + DUMP2("finish current eventloop %lx", current_evloop); return Qnil; } static VALUE -lib_eventloop_launcher(check_root, update_flag, check_var) +lib_eventloop_launcher(check_root, update_flag, check_var, interp) int check_root; int update_flag; int *check_var; + Tcl_Interp *interp; { volatile VALUE parent_evloop = eventloop_thread; struct evloop_params *args = ALLOC(struct evloop_params); @@ -1742,9 +1762,13 @@ lib_eventloop_launcher(check_root, update_flag, check_var) DUMP3("tcltklib: eventloop-thread : %lx -> %lx\n", parent_evloop, eventloop_thread); - args->check_root = check_root; - args->update_flag = update_flag; - args->check_var = check_var; + args->check_root = check_root; + args->update_flag = update_flag; + args->check_var = check_var; + args->interp = interp; + args->thr_crit_bup = rb_thread_critical; + + rb_thread_critical = Qfalse; #if 0 return rb_ensure(lib_eventloop_main, (VALUE)args, @@ -1771,7 +1795,8 @@ lib_mainloop(argc, argv, self) check_rootwidget = Qfalse; } - return lib_eventloop_launcher(RTEST(check_rootwidget), 0, (int*)NULL); + return lib_eventloop_launcher(RTEST(check_rootwidget), 0, + (int*)NULL, (Tcl_Interp*)NULL); } static VALUE @@ -1799,7 +1824,8 @@ static VALUE watchdog_evloop_launcher(check_rootwidget) VALUE check_rootwidget; { - return lib_eventloop_launcher(RTEST(check_rootwidget), 0, (int*)NULL); + return lib_eventloop_launcher(RTEST(check_rootwidget), 0, + (int*)NULL, (Tcl_Interp*)NULL); } #define EVLOOP_WAKEUP_CHANCE 3 @@ -1981,8 +2007,8 @@ lib_thread_callback(argc, argv, self) rb_thread_schedule(); /* start sub-eventloop */ - foundEvent = lib_eventloop_launcher(/* not check root-widget */0, 0, - q->done); + foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, 0, + q->done, (Tcl_Interp*)NULL)); if (RTEST(rb_funcall(th, ID_alive_p, 0))) { rb_funcall(th, ID_kill, 0); @@ -2812,7 +2838,7 @@ ip_rbUpdateCommand(clientData, interp, objc, objv) /* call eventloop */ /* ret = lib_eventloop_core(0, flags, (int *)NULL);*/ /* ignore result */ - ret = lib_eventloop_launcher(0, flags, (int *)NULL); /* ignore result */ + ret = RTEST(lib_eventloop_launcher(0, flags, (int *)NULL, interp)); /* ignore result */ /* exception check */ if (!NIL_P(rbtk_pending_exception)) { @@ -2994,6 +3020,24 @@ ip_rb_threadUpdateCommand(clientData, interp, objc, objv) /***************************/ /* replace of vwait/tkwait */ /***************************/ +#if TCL_MAJOR_VERSION >= 8 +static int ip_rbVwaitObjCmd _((ClientData, Tcl_Interp *, int, + Tcl_Obj *CONST [])); +static int ip_rb_threadVwaitObjCmd _((ClientData, Tcl_Interp *, int, + Tcl_Obj *CONST [])); +static int ip_rbTkWaitObjCmd _((ClientData, Tcl_Interp *, int, + Tcl_Obj *CONST [])); +static int ip_rb_threadTkWaitObjCmd _((ClientData, Tcl_Interp *, int, + Tcl_Obj *CONST [])); +#else +static int ip_rbVwaitCommand _((ClientData, Tcl_Interp *, int, char *[])); +static int ip_rb_threadVwaitCommand _((ClientData, Tcl_Interp *, int, + char *[])); +static int ip_rbTkWaitCommand _((ClientData, Tcl_Interp *, int, char *[])); +static int ip_rb_threadTkWaitCommand _((ClientData, Tcl_Interp *, int, + char *[])); +#endif + #if TCL_MAJOR_VERSION >= 8 static char *VwaitVarProc _((ClientData, Tcl_Interp *, CONST84 char *,CONST84 char *, int)); @@ -3021,10 +3065,7 @@ VwaitVarProc(clientData, interp, name1, name2, flags) return (char *) NULL; } - #if TCL_MAJOR_VERSION >= 8 -static int ip_rbVwaitObjCmd _((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST [])); static int ip_rbVwaitObjCmd(clientData, interp, objc, objv) ClientData clientData; @@ -3032,7 +3073,6 @@ ip_rbVwaitObjCmd(clientData, interp, objc, objv) int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ -static int ip_rbVwaitCommand _((ClientData, Tcl_Interp *, int, char *[])); static int ip_rbVwaitCommand(clientData, interp, objc, objv) ClientData clientData; @@ -3053,6 +3093,20 @@ ip_rbVwaitCommand(clientData, interp, objc, objv) return TCL_ERROR; } +#if 0 + if (!rb_thread_alone() + && eventloop_thread != Qnil + && eventloop_thread != rb_thread_current()) { +#if TCL_MAJOR_VERSION >= 8 + DUMP1("call ip_rb_threadVwaitObjCmd"); + return ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv); +#else /* TCL_MAJOR_VERSION < 8 */ + DUMP1("call ip_rb_threadVwaitCommand"); + return ip_rb_threadVwaitCommand(clientData, interp, objc, objv); +#endif + } +#endif + Tcl_Preserve(interp); #ifdef HAVE_NATIVETHREAD if (!is_ruby_native_thread()) { @@ -3117,8 +3171,8 @@ ip_rbVwaitCommand(clientData, interp, objc, objv) done = 0; - foundEvent - = lib_eventloop_launcher(/* not check root-widget */0, 0, &done); + foundEvent = RTEST(lib_eventloop_launcher(/* not check root-widget */0, + 0, &done, interp)); thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; @@ -3248,8 +3302,6 @@ WaitWindowProc(clientData, eventPtr) } #if TCL_MAJOR_VERSION >= 8 -static int ip_rbTkWaitObjCmd _((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST [])); static int ip_rbTkWaitObjCmd(clientData, interp, objc, objv) ClientData clientData; @@ -3257,7 +3309,6 @@ ip_rbTkWaitObjCmd(clientData, interp, objc, objv) int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ -static int ip_rbTkWaitCommand _((ClientData, Tcl_Interp *, int, char *[])); static int ip_rbTkWaitCommand(clientData, interp, objc, objv) ClientData clientData; @@ -3283,6 +3334,20 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) return TCL_ERROR; } +#if 0 + if (!rb_thread_alone() + && eventloop_thread != Qnil + && eventloop_thread != rb_thread_current()) { +#if TCL_MAJOR_VERSION >= 8 + DUMP1("call ip_rb_threadTkWaitObjCmd"); + return ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv); +#else /* TCL_MAJOR_VERSION < 8 */ + DUMP1("call ip_rb_threadTkWaitCommand"); + return ip_rb_threadTkWwaitCommand(clientData, interp, objc, objv); +#endif + } +#endif + Tcl_Preserve(interp); if (objc != 3) { @@ -3394,7 +3459,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) done = 0; /* lib_eventloop_core(check_rootwidget_flag, 0, &done); */ - lib_eventloop_launcher(check_rootwidget_flag, 0, &done); + lib_eventloop_launcher(check_rootwidget_flag, 0, &done, interp); thr_crit_bup = rb_thread_critical; rb_thread_critical = Qtrue; @@ -3463,7 +3528,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) done = 0; /* lib_eventloop_core(check_rootwidget_flag, 0, &done); */ - lib_eventloop_launcher(check_rootwidget_flag, 0, &done); + lib_eventloop_launcher(check_rootwidget_flag, 0, &done, interp); /* exception check */ if (!NIL_P(rbtk_pending_exception)) { @@ -3560,7 +3625,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv) done = 0; /* lib_eventloop_core(check_rootwidget_flag, 0, &done); */ - lib_eventloop_launcher(check_rootwidget_flag, 0, &done); + lib_eventloop_launcher(check_rootwidget_flag, 0, &done, interp); /* exception check */ if (!NIL_P(rbtk_pending_exception)) { @@ -3678,8 +3743,6 @@ rb_threadWaitWindowProc(clientData, eventPtr) } #if TCL_MAJOR_VERSION >= 8 -static int ip_rb_threadVwaitObjCmd _((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST [])); static int ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv) ClientData clientData; @@ -3687,8 +3750,6 @@ ip_rb_threadVwaitObjCmd(clientData, interp, objc, objv) int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ -static int ip_rb_threadVwaitCommand _((ClientData, Tcl_Interp *, int, - char *[])); static int ip_rb_threadVwaitCommand(clientData, interp, objc, objv) ClientData clientData; @@ -3811,8 +3872,6 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv) } #if TCL_MAJOR_VERSION >= 8 -static int ip_rb_threadTkWaitObjCmd _((ClientData, Tcl_Interp *, int, - Tcl_Obj *CONST [])); static int ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv) ClientData clientData; @@ -3820,8 +3879,6 @@ ip_rb_threadTkWaitObjCmd(clientData, interp, objc, objv) int objc; Tcl_Obj *CONST objv[]; #else /* TCL_MAJOR_VERSION < 8 */ -static int ip_rb_threadTkWaitCommand _((ClientData, Tcl_Interp *, int, - char *[])); static int ip_rb_threadTkWaitCommand(clientData, interp, objc, objv) ClientData clientData; -- cgit v1.2.3