Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-516 Excluding Merge-Ins
This is equivalent to a diff from e891020c32 to 4c8cd0f799
2018-09-27
| ||
07:22 | Implementation of TIP 516: More OO Slot Operations Closed-Leaf check-in: 28f8e4372e user: dkf tags: core-8-branch-timeline-fix | |
07:20 | help Closed-Leaf check-in: 2d2e7d5f73 user: dkf tags: core-8-branch-timeline-fix | |
2018-09-11
| ||
15:39 | merge 8.7 check-in: 0c62aa4c94 user: dgp tags: dgp-string-insert | |
07:44 | Simplify the slot resolution protocol Closed-Leaf check-in: 4c8cd0f799 user: dkf tags: tip-516 | |
2018-09-10
| ||
08:33 | Tests and docs check-in: ede05afd63 user: dkf tags: tip-516 | |
2018-09-08
| ||
21:18 | Merge core-8-branch check-in: 4c53b5eb75 user: jan.nijtmans tags: tip-515 | |
12:52 | Implementation of TIP 516 check-in: 84cceab204 user: dkf tags: tip-516 | |
2018-09-07
| ||
22:23 | Merge 8.6 check-in: 4ccc3b6902 user: jan.nijtmans tags: core-8-branch | |
12:11 | merge 8.7 check-in: 792948e482 user: dgp tags: trunk | |
12:11 | merge 8.6 check-in: e891020c32 user: dgp tags: core-8-branch | |
12:04 | Added test for [631b4c45df]. check-in: 036c01e552 user: dgp tags: core-8-6-branch | |
12:02 | merge 8.6 (segfault fix) check-in: 0a8630528a user: sebres tags: core-8-branch | |
Changes to doc/define.n.
︙ | |||
422 423 424 425 426 427 428 | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 | - + + + + + + + + + + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + | \fBself call\fR). .VE TIP500 .SH "SLOTTED DEFINITIONS" Some of the configurable definitions of a class or object are \fIslotted definitions\fR. This means that the configuration is implemented by a slot object, that is an instance of the class \fBoo::Slot\fR, which manages a list of values (class names, variable names, etc.) that comprises the contents of |
︙ |
Changes to generic/tclOODefineCmds.c.
︙ | |||
33 34 35 36 37 38 39 40 41 | 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 | + - + - + + + | * Some things that make it easier to declare a slot. */ struct DeclaredSlot { const char *name; const Tcl_MethodType getterType; const Tcl_MethodType setterType; const Tcl_MethodType resolverType; }; |
︙ | |||
105 106 107 108 109 110 111 112 113 114 115 116 117 | 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | + + + - - - - - - - - + + + + + + + + | int objc, Tcl_Obj *const *objv); static int ObjVarsGet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ObjVarsSet(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int ResolveClass(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); /* * Now define the slots used in declarations. */ static const struct DeclaredSlot slots[] = { |
︙ | |||
2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 | 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 | + + - + + + + + + | int TclOODefineSlots( Foundation *fPtr) { const struct DeclaredSlot *slotInfoPtr; Tcl_Obj *getName = Tcl_NewStringObj("Get", -1); Tcl_Obj *setName = Tcl_NewStringObj("Set", -1); Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1); Class *slotCls; slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr; if (slotCls == NULL) { return TCL_ERROR; } Tcl_IncrRefCount(getName); Tcl_IncrRefCount(setName); Tcl_IncrRefCount(resolveName); for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) { Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp, |
︙ | |||
2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 | 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | if (IsPrivateDefine(interp)) { InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv, oPtr->creationEpoch); } else { InstallStandardVariableMapping(&oPtr->variables, varc, varv); } return TCL_OK; } /* * ---------------------------------------------------------------------- * * ResolveClass -- * * Implementation of the "Resolve" support method for some slots (those * that are slots around a list of classes). This resolves possible class * names to their fully-qualified names if possible. * * ---------------------------------------------------------------------- */ static int ResolveClass( ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv) { int idx = Tcl_ObjectContextSkippedArgs(context); Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Class *clsPtr; /* * Check if were called wrongly. The definition context isn't used... * except that GetClassInOuterContext() assumes that it is there. */ if (oPtr == NULL) { return TCL_ERROR; } else if (objc != idx + 1) { Tcl_WrongNumArgs(interp, idx, objv, "slotElement"); return TCL_ERROR; } /* * Resolve the class if possible. If not, remove any resolution error and * return what we've got anyway as the failure might not be fatal overall. */ clsPtr = GetClassInOuterContext(interp, objv[idx], "USER SHOULD NOT SEE THIS MESSAGE"); if (clsPtr == NULL) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, objv[idx]); } else { Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr)); } return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclOOScript.h.
︙ | |||
143 144 145 146 147 148 149 | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | + + + - + + + + + + + - + + + + + + + + + + + + + + + - + | "\tdefine Slot {\n" "\t\tmethod Get {} {\n" "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n" "\t\t}\n" "\t\tmethod Set list {\n" "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n" "\t\t}\n" "\t\tmethod Resolve list {\n" "\t\t\treturn $list\n" "\t\t}\n" |
︙ |
Changes to generic/tclOOScript.tcl.
︙ | |||
272 273 274 275 276 277 278 279 280 281 282 283 284 285 | 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 | + + + + + + + + + + + + + + - + + + + + + + - + + + + + + + + + + + + + + + - + | method Set list { return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" } # ------------------------------------------------------------------ # # Slot Resolve -- # # Helper that lets a slot convert a list of arguments of a # particular type to their canonical forms. Defaults to doing # nothing (suitable for simple strings). # # ------------------------------------------------------------------ method Resolve list { return $list } # ------------------------------------------------------------------ # # Slot -set, -append, -clear, --default-operation -- # # Standard public slot operations. If a slot can't figure out # what method to call directly, it uses --default-operation. # # ------------------------------------------------------------------ |
︙ |
Changes to tests/oo.test.
︙ | |||
9 10 11 12 13 14 15 | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | - - | package require TclOO 1.0.3 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* } |
︙ | |||
3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 | 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 | + + + + + | } method Set {lst} { variable contents $lst variable ops lappend ops [info level] Set $lst return } method Resolve {lst} { variable ops lappend ops [info level] Resolve $lst return $lst } } } append script0 \n$script } proc SampleSlotCleanup script { set script0 { |
︙ | |||
3868 3869 3870 3871 3872 3873 3874 | 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 | - + - + - + + + + + + + + + + + + + + + + + | test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup { SampleSlot create sampleSlot }] -body { list [info level] [sampleSlot -append g h i] \ [sampleSlot contents] [sampleSlot ops] } -cleanup [SampleSlotCleanup { rename sampleSlot {} |
︙ | |||
3907 3908 3909 3910 3911 3912 3913 | 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 | - + - + | test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup { set s [SampleSlot new] }] -body { oo::objdefine $s forward --default-operation my -set list [$s destroy; $s unknown] [$s contents] [$s ops] } -cleanup [SampleSlotCleanup { rename $s {} |
︙ | |||
3946 3947 3948 3949 3950 3951 3952 | 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 3996 3997 3998 3999 4000 4001 4002 4003 4004 4005 4006 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 | - + - + - + - + - + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | } {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} proc getMethods obj { list [lsort [info object methods $obj -all]] \ [lsort [info object methods $obj -private]] } test oo-34.3 {TIP 380: slots - presence} { getMethods oo::define::filter |
︙ |