[ruby-list:41658] Re: MacOS X Aqua 対応のための tcltklib の extconf.rb

永井@知能．九工大です．

From: 天野 竜太郎 <[e-mail]>
Subject: [ruby-list:41653] Re: MacOS X Aqua 対応のための tcltklib の extconf.rb
Date: Sun, 4 Dec 2005 17:47:54 +0900
Message-ID: <[e-mail]>
> 固まっていない状況では、「閉じるボタン」は生きています。クリック 
> すると該当ウィンドウは消えます。

え゛．メッセージボックスが閉じるボタンで消せちゃうんですか？
「これは〜という種類のメッセージボックスで…」というウィンドウですよね？
このウィンドウも「あなたは〜を押しましたね」のウィンドウも，
閉じるボタンで消せてしまうのはマズイはずです．
閉じるボタンで消してしまうと Tcl 変数への書き込みが行われず，
vwait 処理が終了しないままになってしまいます．

お手数ですが，以下を実行して
-----------------------------------
require 'tk'

# toplevel 1
t = TkToplevel.new(:title=>'toplevel1')
t.protocol('WM_DELETE_WINDOW', proc{puts 'DIE HARD!!'})

# toplevel 2
Tk.ip_eval('
  toplevel .top2
  wm title .top2 toplevel2
  wm protocol .top2 WM_DELETE_WINDOW {puts "DIE HARD2!!"}
')

# toplevel 3
Tk.ip_eval('
  toplevel .top3
  wm title .top3 toplevel3
  wm protocol .top3 WM_DELETE_WINDOW { }
')

Tk.mainloop
-----------------------------------
表示されたトップレベルウィジェットにおいて閉じるボタンを押すと，
toplevel1 と toplevel2 はそれぞれ文字列を出力し，
toplevel3 は単に無視するという動作をするかどうかを確認ください．

もし，toplevel1 だけが期待通りに動かないのであれば
Ruby/Tk 側に問題があります．

すべてが期待通りに動かないのであれば，wm protocol コマンドの
動作がおかしいということで，Tcl/TkAqua 側の問題です．
toplevel3 だけが期待通りに動かない場合も Tcl/TkAqua 側の問題ですが，
この場合は空のコマンドの登録がうまくいかないという特殊ケースです．

これらすべてが期待通りに動くにもかかわらず，メッセージボックスは
閉じるボタンで閉じてしまうというということであれば，
他との絡みで何か奇妙な状況が生じているのかもしれません．
その場合，Tcl/TkAqua のウィジェットデモでも閉じるボタンで閉じるなら
Tcl/TkAqua 側の問題なので仕方がありません．
逆に Tcl/TkAqua のウィジェットデモでは閉じるボタンでは閉じないのなら
Ruby/Tk 側の問題となります．

とはいえ，今回の「固まる」という状況は，閉じるボタンによって
ウィンドウを消した場合でなくても (閉じるボタンには触れず，
きちんとダイアログ上のボタンをクリックした結果として
ウィンドウが消えた場合でも) 発生するのですよね？

添付のパッチは「vwait 処理中にスレッド切り替えや割り込み処理が
うまく働かなくなることがある」というバグの修正を加えたものです．
今回の問題とは直接の関係はないだろうとは思いますが，
念のために添えておきます．
1.8.4preview2 からの差分になっているはずです．

# MacOS X マシンが手元に１台あれば．．．(;_;)

> 「最大化ボタン」は、固まっていない状況でも機能しませんでした。

ということは，やはり元々大きさ変更を許していないために
機能しないようにみえるというだけですね．
ですので，この件も正常な動作であろうと思います．

> demos-enでも同じ状況です。念のため英語環境でログインし直して、 
> demos-enを使いましたが、同じでした。

ありがとうございます．
おかげで日本語フォント処理で悪さをしていることはないということを
確認できました．
--
                                       永井 秀利 （九工大 知能情報）
                                           [e-mail]

--- tcltklib.c.old	2005-11-18 16:17:37.000000000 +0900
+++ tcltklib.c	2005-12-04 12:20:33.000000000 +0900
@@ -1271,10 +1271,11 @@
 
 
 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 @@
                 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 @@
                     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 @@
     int check_root;
     int update_flag;
     int *check_var;
+    Tcl_Interp *interp;
+    int thr_crit_bup;
 };
 
 VALUE
@@ -1623,7 +1636,8 @@
 
     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 @@
     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 @@
 
     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 @@
     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 @@
         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 @@
 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 @@
     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 @@
 
     /* 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)) {
@@ -2995,6 +3021,24 @@
 /* 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));
 static char *
@@ -3021,10 +3065,7 @@
     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 @@
     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 @@
         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 @@
 
     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 @@
 }
 
 #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 @@
     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 @@
         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 @@
 
         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 @@
 
         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 @@
 
         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 @@
 }
 
 #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 @@
     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 @@
 }
 
 #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 @@
     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;