summaryrefslogtreecommitdiff
path: root/x11/ruby-tcltklib/patches/patch-aa
blob: a74212dd2637c24b190d51e54d604ee6cce578ea (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
$NetBSD: patch-aa,v 1.1 2005/01/23 17:36:59 taca Exp $

--- ext/tcltklib/tcltklib.c.orig	2004-12-23 13:16:42.000000000 +0900
+++ ext/tcltklib/tcltklib.c
@@ -4,7 +4,7 @@
  *              Oct. 24, 1997   Y. Matsumoto
  */
 
-#define TCLTKLIB_RELEASE_DATE "2004-12-23"
+#define TCLTKLIB_RELEASE_DATE "2004-12-27"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -70,9 +70,13 @@ fprintf(stderr, ARG1, ARG2); fprintf(std
 /* release date */
 const char tcltklib_release_date[] = TCLTKLIB_RELEASE_DATE;
 
-/*finalize_proc_name */
+/* finalize_proc_name */
 static char *finalize_hook_name = "INTERP_FINALIZE_HOOK";
 
+/* to cancel remained after-scripts when deleting IP */
+#define REMAINED_AFTER_IDS_VAR "__ruby_tcltklib_remained_after_script_list__"
+#define CANCEL_REMAINED_AFTER_IDS "foreach id $__ruby_tcltklib_remained_after_script_list__ {after cancel $id}"
+
 /* for callback break & continue */
 static VALUE eTkCallbackReturn;
 static VALUE eTkCallbackBreak;
@@ -3312,12 +3316,16 @@ delete_slaves(ip)
 
         Tcl_Preserve(slave);
 
-#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
-#else
         if (!Tcl_InterpDeleted(slave)) {
-            Tcl_Eval(slave, "foreach i [after info] { after cancel $i }");
+            if (Tcl_Eval(slave, "after info") == TCL_OK
+                && Tcl_SetVar(slave, 
+                              REMAINED_AFTER_IDS_VAR, 
+                              Tcl_GetStringResult(slave), 
+                              TCL_GLOBAL_ONLY) != (char *)NULL) {
+                DUMP1("cancel after scripts");
+                Tcl_Eval(slave, CANCEL_REMAINED_AFTER_IDS);
+            }
         }
-#endif
 
         /* delete slaves of slave */
         delete_slaves(slave);
@@ -3360,18 +3368,20 @@ ip_free(ptr)
 
             Tcl_ResetResult(ptr->ip);
 
+            if (Tcl_Eval(ptr->ip, "after info") == TCL_OK
+                && Tcl_SetVar(ptr->ip, 
+                              REMAINED_AFTER_IDS_VAR, 
+                              Tcl_GetStringResult(ptr->ip), 
+                              TCL_GLOBAL_ONLY) != (char *)NULL) {
+                DUMP1("cancel after scripts");
+                Tcl_Eval(ptr->ip, CANCEL_REMAINED_AFTER_IDS);
+            }
+
             if (Tcl_GetCommandInfo(ptr->ip, finalize_hook_name, &info)) {
                 DUMP2("call finalize hook proc '%s'", finalize_hook_name);
                 Tcl_Eval(ptr->ip, finalize_hook_name);
             }
 
-#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
-#else
-            if (!Tcl_InterpDeleted(ptr->ip)) {
-                Tcl_Eval(ptr->ip, "foreach i [after info] {after cancel $i}");
-            }
-#endif
-
             del_root(ptr->ip);
 
             DUMP1("delete interp");
@@ -3838,12 +3848,14 @@ ip_delete(self)
     /* Tcl_Preserve(ptr->ip); */
     rbtk_preserve_ip(ptr);
 
-#if TCL_MAJOR_VERSION < 8 || ( TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4)
-#else
-    if (!Tcl_InterpDeleted(ptr->ip)) {
-        Tcl_Eval(ptr->ip, "foreach i [after info] { after cancel $i }");
+    if (Tcl_Eval(ptr->ip, "after info") == TCL_OK
+        && Tcl_SetVar(ptr->ip, 
+                      REMAINED_AFTER_IDS_VAR, 
+                      Tcl_GetStringResult(ptr->ip), 
+                      TCL_GLOBAL_ONLY) != (char *)NULL) {
+        DUMP1("cancel after scripts");
+        Tcl_Eval(ptr->ip, CANCEL_REMAINED_AFTER_IDS);
     }
-#endif
 
     del_root(ptr->ip);
 
@@ -4188,6 +4200,7 @@ ip_eval(self, str)
         rb_thread_stop();
     }
     DUMP2("back from handler (current thread:%lx)", current);
+    DUMP1("ip_eval back:111");
 
     /* get result & free allocated memory */
     ret = RARRAY(result)->ptr[0];