Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge with trunk |
---|---|
Timelines: | family | ancestors | descendants | both | wtf-8-experiment |
Files: | files | file ages | folders |
SHA1: |
b0632ecbad0d335ef7f7fc296285803e |
User & Date: | chw 2019-05-29 03:58:10.792 |
Context
2019-05-30
| ||
15:11 | merge with trunk check-in: 5198b4c951 user: chw tags: wtf-8-experiment | |
2019-05-29
| ||
03:58 | merge with trunk check-in: b0632ecbad user: chw tags: wtf-8-experiment | |
03:47 | add tk upstream changes check-in: d299632677 user: chw tags: trunk | |
2019-05-26
| ||
21:26 | merge with trunk check-in: 9825426608 user: chw tags: wtf-8-experiment | |
Changes
Deleted jni/sdl2tk/README.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Added jni/sdl2tk/README.md.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # README: Tk This is the **Tk 8.6.9** source distribution. You can get any source release of Tk from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). ## <a id="intro">1.</a> Introduction This directory contains the sources and documentation for Tk, a cross-platform GUI toolkit implemented with the Tcl scripting language. For details on features, incompatibilities, and potential problems with this release, see [the Tcl/Tk 8.6 Web page](https://www.tcl.tk/software/tcltk/8.6.html) or refer to the "changes" file in this directory, which contains a historical record of all changes to Tk. Tk is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests takes place at [core.tcl-lang.org](https://core.tcl-lang.org/). Tcl/Tk release and mailing list services are [hosted by SourceForge](https://sourceforge.net/projects/tcl/) with the Tcl Developer Xchange hosted at [www.tcl-lang.org](https://www.tcl-lang.org). Tk is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## <a id="tcl">2.</a> See Tcl README.md Please see the README.md file that comes with the associated Tcl release for more information. There are pointers there to extensive documentation. In addition, there are additional README files in the subdirectories of this distribution. |
Changes to jni/sdl2tk/tests/ttk/treeview.test.
︙ | ︙ | |||
684 685 686 687 688 689 690 691 692 693 694 695 696 697 | # a mouse click on the (invisible since we're on a leaf) indicator event generate .tv <ButtonPress-1> \ -x [expr ($x + $h / 2)] \ -y [expr ($y + $h / 2)] lappend res [.tv item foo -open] .tv insert foo end -text "sub" lappend res [.tv item foo -open] } -result {0 0 0} test treeview-ce470f20fd-1 "dragging further than the right edge of the treeview is forbidden" -setup { pack [ttk::treeview .tv] .tv heading #0 -text "Drag my right edge -->" update } -body { | > > | 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 | # a mouse click on the (invisible since we're on a leaf) indicator event generate .tv <ButtonPress-1> \ -x [expr ($x + $h / 2)] \ -y [expr ($y + $h / 2)] lappend res [.tv item foo -open] .tv insert foo end -text "sub" lappend res [.tv item foo -open] } -cleanup { destroy .tv } -result {0 0 0} test treeview-ce470f20fd-1 "dragging further than the right edge of the treeview is forbidden" -setup { pack [ttk::treeview .tv] .tv heading #0 -text "Drag my right edge -->" update } -body { |
︙ | ︙ |
Changes to jni/sdl2tk/tests/winfo.test.
︙ | ︙ | |||
392 393 394 395 396 397 398 | rooty [expr {[winfo rooty .emb] == [winfo rooty .con]}] } -cleanup { deleteWindows } -result {rootx 1 rooty 1} # Windows does not destroy the container when an embedded window is # destroyed. Unix and macOS do destroy it. See ticket [67384bce7d]. | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | rooty [expr {[winfo rooty .emb] == [winfo rooty .con]}] } -cleanup { deleteWindows } -result {rootx 1 rooty 1} # Windows does not destroy the container when an embedded window is # destroyed. Unix and macOS do destroy it. See ticket [67384bce7d]. if {[tk windowingsystem] == "win32"} { set result_13_2 {embedded 0 container 1} } else { set result_13_2 {embedded 0 container 0} } test winfo-13.2 {destroying embedded toplevel} -setup { deleteWindows } -body { |
︙ | ︙ |
Changes to jni/sdl2tk/unix/Makefile.in.
︙ | ︙ | |||
1564 1565 1566 1567 1568 1569 1570 | fi; \ done;) mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[ch] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog \ | | | 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | fi; \ done;) mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[ch] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog \ $(TOP_DIR)/ChangeLog.2??? $(TOP_DIR)/README.md \ $(TOP_DIR)/license.terms $(DISTDIR) rm -f $(DISTDIR)/generic/blt*.[ch] mkdir $(DISTDIR)/generic/ttk cp -p $(TTK_DIR)/*.[ch] $(TTK_DIR)/ttk.decls \ $(TTK_DIR)/ttkGenStubs.tcl $(DISTDIR)/generic/ttk mkdir $(DISTDIR)/win cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win |
︙ | ︙ |
Deleted jni/tcl/README.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Added jni/tcl/README.md.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 106 107 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 139 140 141 142 143 144 145 146 | # README: Tcl This is the **Tcl 8.6.9** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). ## Contents 1. [Introduction](#intro) 2. [Documentation](#doc) 3. [Compiling and installing Tcl](#build) 4. [Development tools](#devtools) 5. [Tcl newsgroup](#complangtcl) 6. [The Tcler's Wiki](#wiki) 7. [Mailing lists](#email) 8. [Support and Training](#support) 9. [Tracking Development](#watch) 10. [Thank You](#thanks) ## <a id="intro">1.</a> Introduction Tcl provides a powerful platform for creating integration applications that tie together diverse applications, protocols, devices, and frameworks. When paired with the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that run on PCs, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and for creating powerful command languages for applications. Tcl is maintained, enhanced, and distributed freely by the Tcl community. Source code development and tracking of bug reports and feature requests takes place at [core.tcl-lang.org](https://core.tcl-lang.org/). Tcl/Tk release and mailing list services are [hosted by SourceForge](https://sourceforge.net/projects/tcl/) with the Tcl Developer Xchange hosted at [www.tcl-lang.org](https://www.tcl-lang.org). Tcl is a freely available open source package. You can do virtually anything you like with it, such as modifying it, redistributing it, and selling it either in whole or in part. See the file `license.terms` for complete information. ## <a id="doc">2.</a> Documentation Extensive documentation is available at our website. The home page for this release, including new features, is [here](https://www.tcl.tk/software/tcltk/8.6.html). Detailed release notes can be found at the [file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/) by clicking on the relevant version. Information about Tcl itself can be found at the [Developer Xchange](https://www.tcl-lang.org/about/). There have been many Tcl books on the market. Many are mentioned in [the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206). The complete set of reference manual entries for Tcl 8.6 is [online, here](https://www.tcl-lang.org/man/tcl8.6/). ### <a id="doc.unix">2a.</a> Unix Documentation The `doc` subdirectory in this release contains a complete set of reference manual entries for Tcl. Files with extension "`.1`" are for programs (for example, `tclsh.1`); files with extension "`.3`" are for C library procedures; and files with extension "`.n`" describe Tcl commands. The file "`doc/Tcl.n`" gives a quick summary of the Tcl language syntax. To print any of the man pages on Unix, cd to the "doc" directory and invoke your favorite variant of troff using the normal -man macros, for example groff -man -Tpdf Tcl.n >output.pdf to print Tcl.n to PDF. If Tcl has been installed correctly and your "man" program supports it, you should be able to access the Tcl manual entries using the normal "man" mechanisms, such as man Tcl ### <a id="doc.win">2b.</a> Windows Documentation The "doc" subdirectory in this release contains a complete set of Windows help files for Tcl. Once you install this Tcl release, a shortcut to the Windows help Tcl documentation will appear in the "Start" menu: Start | Programs | Tcl | Tcl Help ## <a id="build">3.</a> Compiling and installing Tcl There are brief notes in the `unix/README`, `win/README`, and `macosx/README` about compiling on these different platforms. There is additional information about building Tcl from sources [online](https://www.tcl-lang.org/doc/howto/compile.html). ## <a id="devtools">4.</a> Development tools ActiveState produces a high quality set of commercial quality development tools that is available to accelerate your Tcl application development. Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger, static code checker, single-file wrapping utility, bytecode compiler and more. More information can be found at http://www.ActiveState.com/Tcl ## <a id="complangtcl">5.</a> Tcl newsgroup There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of information about Tcl, Tk, and related applications. The newsgroup is a great place to ask general information questions. For bug reports, please see the "Support and bug fixes" section below. ## <a id="wiki">6.</a> Tcl'ers Wiki There is a [wiki-based open community site](https://wiki.tcl-lang.org/) covering all aspects of Tcl/Tk. It is dedicated to the Tcl programming language and its extensions. A wealth of useful information can be found there. It contains code snippets, references to papers, books, and FAQs, as well as pointers to development tools, extensions, and applications. You can also recommend additional URLs by editing the wiki yourself. ## <a id="email">7.</a> Mailing lists Several mailing lists are hosted at SourceForge to discuss development or use issues (like Macintosh and Windows topics). For more information and to subscribe, visit [here](https://sourceforge.net/projects/tcl/) and go to the Mailing Lists page. ## <a id="support">8.</a> Support and Training We are very interested in receiving bug reports, patches, and suggestions for improvements. We prefer that you send this information to us as tickets entered into [our issue tracker](https://core.tcl-lang.org/tcl/reportlist). We will log and follow-up on each bug, although we cannot promise a specific turn-around time. Enhancements may take longer and may not happen at all unless there is widespread support for them (we're trying to slow the rate at which Tcl/Tk turns into a kitchen sink). It's very difficult to make incompatible changes to Tcl/Tk at this point, due to the size of the installed base. The Tcl community is too large for us to provide much individual support for users. If you need help we suggest that you post questions to `comp.lang.tcl` or ask a question on [Stack Overflow](https://stackoverflow.com/questions/tagged/tcl). We read the newsgroup and will attempt to answer esoteric questions for which no one else is likely to know the answer. In addition, see the wiki for [links to other organizations](https://wiki.tcl-lang.org/training) that offer Tcl/Tk training. ## <a id="watch">9.</a> Tracking Development Tcl is developed in public. You can keep an eye on how Tcl is changing at [core.tcl-lang.org](https://core.tcl-lang.org/). ## <a id="thanks">10.</a> Thank You We'd like to express our thanks to the Tcl community for all the helpful suggestions, bug reports, and patches we have received. Tcl/Tk has improved vastly and will continue to do so with your help. |
Changes to jni/tcl/generic/tclBasic.c.
︙ | ︙ | |||
7764 7765 7766 7767 7768 7769 7770 | return TCL_ERROR; } if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; /* | | | 7764 7765 7766 7767 7768 7769 7770 7771 7772 7773 7774 7775 7776 7777 7778 | return TCL_ERROR; } if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; /* * To ensure different seeds in different threads (bug #416643), * take into consideration the thread this interp is running in. */ iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. |
︙ | ︙ |
Changes to jni/tcl/generic/tclCmdIL.c.
︙ | ︙ | |||
3933 3934 3935 3936 3937 3938 3939 | sortInfo.indexv = NULL; } else { sortInfo.indexc--; /* * Do not shrink the actual memory block used; that doesn't * work with TclStackAlloc-allocated memory. [Bug 2918962] | | | 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 | sortInfo.indexv = NULL; } else { sortInfo.indexc--; /* * Do not shrink the actual memory block used; that doesn't * work with TclStackAlloc-allocated memory. [Bug 2918962] * * TODO: Consider a pointer increment to replace this * array shift. */ for (i = 0; i < sortInfo.indexc; i++) { sortInfo.indexv[i] = sortInfo.indexv[i+1]; } |
︙ | ︙ |
Changes to jni/tcl/generic/tclExecute.c.
︙ | ︙ | |||
5243 5244 5245 5246 5247 5248 5249 | NEXT_INST_F(9, 0, 0); } goto emptyList; } /* Decode index value operands. */ | | | 5243 5244 5245 5246 5247 5248 5249 5250 5251 5252 5253 5254 5255 5256 5257 | NEXT_INST_F(9, 0, 0); } goto emptyList; } /* Decode index value operands. */ /* assert ( toIdx != TCL_INDEX_AFTER); * * Extra safety for legacy bytecodes: */ if (toIdx == TCL_INDEX_AFTER) { toIdx = TCL_INDEX_END; } |
︙ | ︙ | |||
8266 8267 8268 8269 8270 8271 8272 | lResult *= l1; /* b**7 */ break; case 8: lResult *= lResult; /* b**4 */ lResult *= lResult; /* b**8 */ break; } | | | 8266 8267 8268 8269 8270 8271 8272 8273 8274 8275 8276 8277 8278 8279 8280 | lResult *= l1; /* b**7 */ break; case 8: lResult *= lResult; /* b**4 */ lResult *= lResult; /* b**8 */ break; } return lResult; } #endif static inline Tcl_WideInt WidePwrSmallExpon(Tcl_WideInt w1, long exponent) { Tcl_WideInt wResult; |
︙ | ︙ |
Changes to jni/tcl/generic/tclListObj.c.
︙ | ︙ | |||
132 133 134 135 136 137 138 | } /* *---------------------------------------------------------------------- * * AttemptNewList -- * | | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | } /* *---------------------------------------------------------------------- * * AttemptNewList -- * * Like NewListIntRep, but additionally sets an error message on failure. * *---------------------------------------------------------------------- */ static List * AttemptNewList( Tcl_Interp *interp, int objc, |
︙ | ︙ | |||
230 231 232 233 234 235 236 | } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewListObj -- | | | | 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewListObj -- * * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the * file name and line number from its caller. This simplifies debugging * since the [memory active] command will report the correct file * name and line number when reporting objects that haven't been freed. * * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG |
︙ | ︙ | |||
691 692 693 694 695 696 697 | * TCL_OK * * A pointer to the element at 'index' is stored in 'objPtrPtr'. If * 'index' is out of range, NULL is stored in 'objPtrPtr'. This * object should be treated as readonly and its 'refCount' is _not_ * incremented. The caller must do that if it holds on to the * reference. | | | 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 | * TCL_OK * * A pointer to the element at 'index' is stored in 'objPtrPtr'. If * 'index' is out of range, NULL is stored in 'objPtrPtr'. This * object should be treated as readonly and its 'refCount' is _not_ * incremented. The caller must do that if it holds on to the * reference. * * TCL_ERROR * * 'listPtr' is not a valid list. An an error message is left in the * interpreter's result if 'interp' is not NULL. * * Effect * |
︙ | ︙ | |||
1327 1328 1329 1330 1331 1332 1333 | * duplicated, its 'refCount' is incremented. The reference count of * an unduplicated object is therefore 2 (one for the returned pointer * and one for the variable that holds it). The reference count of a * duplicate object is 1, reflecting that result is the only active * reference. The caller is expected to store the result in the * variable and decrement its reference count. (INST_STORE_* does * exactly this.) | | | | 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | * duplicated, its 'refCount' is incremented. The reference count of * an unduplicated object is therefore 2 (one for the returned pointer * and one for the variable that holds it). The reference count of a * duplicate object is 1, reflecting that result is the only active * reference. The caller is expected to store the result in the * variable and decrement its reference count. (INST_STORE_* does * exactly this.) * * NULL * * An error occurred. If 'listPtr' was duplicated, the reference * count on the duplicate is decremented so that it is 0, causing any * memory allocated by this function to be freed. * * * Effect * |
︙ | ︙ |
Changes to jni/tcl/generic/tclObj.c.
︙ | ︙ | |||
2472 2473 2474 2475 2476 2477 2478 | * Value * * TCL_OK * * Success. * * TCL_ERROR | | | 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 | * Value * * TCL_OK * * Success. * * TCL_ERROR * * An error occurred during conversion or the integral value can not * be represented as an integer (it might be too large). An error * message is left in the interpreter's result if 'interp' is not * NULL. * * Effect * |
︙ | ︙ |
Changes to jni/tcl/generic/tclPkg.c.
︙ | ︙ | |||
506 507 508 509 510 511 512 | static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ | | | 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result) { PkgAvail *availPtr, *bestPtr, *bestStablePtr; char *availVersion, *bestVersion, *bestStableVersion; /* Internal rep. of versions */ int availStable, satisfies; Require *reqPtr = data[0]; int reqc = PTR2INT(data[1]); Tcl_Obj **const reqv = data[2]; const char *name = reqPtr->name; Package *pkgPtr = reqPtr->pkgPtr; Interp *iPtr = (Interp *) interp; |
︙ | ︙ |
Changes to jni/tcl/generic/tclStringObj.c.
︙ | ︙ | |||
499 500 501 502 503 504 505 | return length == 0; } if (TclIsPureDict(objPtr)) { Tcl_DictObjSize(NULL, objPtr, &length); return length == 0; } | | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | return length == 0; } if (TclIsPureDict(objPtr)) { Tcl_DictObjSize(NULL, objPtr, &length); return length == 0; } if (objPtr->bytes == NULL) { return TCL_EMPTYSTRING_UNKNOWN; } return objPtr->length == 0; } /* |
︙ | ︙ |
Changes to jni/tcl/generic/tclTest.c.
︙ | ︙ | |||
4967 4968 4969 4970 4971 4972 4973 | * * TestpurebytesobjObjCmd -- * * This object-based procedure constructs a pure bytes object * without type and with internal representation containing NULL's. * * If no argument supplied it returns empty object with tclEmptyStringRep, | | | 4967 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 | * * TestpurebytesobjObjCmd -- * * This object-based procedure constructs a pure bytes object * without type and with internal representation containing NULL's. * * If no argument supplied it returns empty object with tclEmptyStringRep, * otherwise it returns this as pure bytes object with bytes value equal * string. * * Results: * Returns the TCL_OK result code. * * Side effects: * None. |
︙ | ︙ |
Changes to jni/tcl/generic/tclUtil.c.
︙ | ︙ | |||
1705 1706 1707 1708 1709 1710 1711 | { const char *l = bytes + length; const char *p = Tcl_UtfPrev(l, bytes); if (Tcl_UtfCharComplete(p, l - p)) { return bytes; } | | | 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 | { const char *l = bytes + length; const char *p = Tcl_UtfPrev(l, bytes); if (Tcl_UtfCharComplete(p, l - p)) { return bytes; } /* * Malformed utf-8 end, be sure we've NTS to safe compare of end-character, * avoid segfault by access violation out of range. */ Tcl_DStringAppend(buffer, bytes, length); return Tcl_DStringValue(buffer); } /* |
︙ | ︙ | |||
3686 3687 3688 3689 3690 3691 3692 | * * Provides an integer corresponding to the list index held in a Tcl * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * * Value * TCL_OK | | | | | | | | 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 | * * Provides an integer corresponding to the list index held in a Tcl * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * * Value * TCL_OK * * The index is stored at the address given by by 'indexPtr'. If * 'objPtr' has the value "end", the value stored is 'endValue'. * * TCL_ERROR * * The value of 'objPtr' does not have one of the expected formats. If * 'interp' is non-NULL, an error message is left in the interpreter's * result object. * * Effect * * The object referenced by 'objPtr' is converted, as needed, to an * integer, wide integer, or end-based-index object. * *---------------------------------------------------------------------- */ int TclGetIntForIndex( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, then no error message is left after |
︙ | ︙ | |||
3858 3859 3860 3861 3862 3863 3864 | } /* TODO: Handle overflow cases sensibly */ *indexPtr = endValue + (int)objPtr->internalRep.longValue; return TCL_OK; } | | | 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 | } /* TODO: Handle overflow cases sensibly */ *indexPtr = endValue + (int)objPtr->internalRep.longValue; return TCL_OK; } /* *---------------------------------------------------------------------- * * SetEndOffsetFromAny -- * * Look for a string of the form "end[+-]offset" and convert it to an * internal representation holding the offset. |
︙ | ︙ | |||
4036 4037 4038 4039 4040 4041 4042 | } else if (idx == INT_MAX) { /* This index value is always "after the end" */ idx = after; } /* usual case, the absolute index value encodes itself */ } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) { /* | | | | 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 | } else if (idx == INT_MAX) { /* This index value is always "after the end" */ idx = after; } /* usual case, the absolute index value encodes itself */ } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) { /* * We parsed an end+offset index value. * idx holds the offset value in the range INT_MIN...INT_MAX. */ if (idx > 0) { /* * All end+postive or end-negative expressions * always indicate "after the end". */ idx = after; } else if (idx < INT_MIN - TCL_INDEX_END) { /* These indices always indicate "before the beginning */ idx = before; } else { |
︙ | ︙ |
Changes to jni/tcl/unix/Makefile.in.
︙ | ︙ | |||
1994 1995 1996 1997 1998 1999 2000 | chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix @mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic | | | 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 | chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix @mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library for i in http1.0 http opt msgcat reg dde tcltest platform; \ do \ |
︙ | ︙ |
Changes to jni/topcua/examples/fuse.tcl.
︙ | ︙ | |||
45 46 47 48 49 50 51 | } # OPCUA connect and retrieve tree into variable ::T, # key is browse path, value a list of node ID and # class path, thus variables can be identified # with the pattern "*/Variable" on the class path. # Variable ::R is for reverse mapping node ID to | | > > > > > > > > > > > > > | > | > > | > | | > | 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 106 107 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 | } # OPCUA connect and retrieve tree into variable ::T, # key is browse path, value a list of node ID and # class path, thus variables can be identified # with the pattern "*/Variable" on the class path. # Variable ::R is for reverse mapping node ID to # browse path. Namespace prefixes are stripped # from browse paths, as long as they are unique # among the entire address space. log "starting up" opcua new client C log "connecting to $url" opcua connect C $url log "connected" # Fetch custom types, if any catch {opcua gentypes C} log "fetched types, if any" apply {tree { foreach {brpath nodeid clspath refid typeid} $tree { set short $brpath regsub -all -- {/[1-9][0-9]*:} $short {/} short incr t($short) } foreach {brpath nodeid clspath refid typeid} $tree { set short $brpath regsub -all -- {/[1-9][0-9]*:} $short {/} short if {$t($short) == 1} { set brpath $short } set ::T($brpath) [list $nodeid $clspath] set ::R($nodeid) $brpath } }} [opcua ptree C] log "fetched tree" # Fuse entry points; the "fs_getattr" function fills # a cache when an OPCUA variable is referenced. # Other functions work with cached entries later. proc fs_getattr {context path} { log "getattr $path" if {$path eq "/"} { return [dict create type directory mode 0755 nlinks 2] } if {[info exists ::T($path)]} { lassign $::T($path) nodeid clspath if {[string match "*/Variable" $clspath]} { set now [clock seconds] # Fetch Value attribute into cache, if cache entry doesn't # exist at all, or is not open and older than 10 seconds. if {![info exists ::D($nodeid)] || ($::U($nodeid) <= 0 && $now - $::M($nodeid) >= 10)} { log "refresh $path" if {[catch {set ::D($nodeid) [opcua read C $nodeid]}]} { return -code error -errorcode [list POSIX EIO {}] } set ::M($nodeid) $now set ::U($nodeid) 0 } return [dict create mode 0666 nlinks 1 \ mtime $::M($nodeid) \ size [string length $::D($nodeid)]] } return [dict create type directory mode 0755 nlinks 2] } return -code error -errorcode [list POSIX ENOENT {}] } proc fs_open {context path fileinfo} { log "open $path" if {[info exists ::T($path)]} { lassign $::T($path) nodeid clspath if {[string match "*/Variable" $clspath]} { # Cached Value attribute must exist if {"RDONLY" ni [dict get $fileinfo flags] || ![info exists ::D($nodeid)]} { return -code error -errorcode [list POSIX EACCES {}] } # Success, increment use counter and return empty result. incr ::U($nodeid) return } return -code error -errorcode [list POSIX EACCES {}] } return -code error -errorcode [list POSIX ENOENT {}] } proc fs_readdir {context path fileinfo} { log "readdir $path" if {[info exists ::T($path)]} { |
︙ | ︙ | |||
160 161 162 163 164 165 166 | # Success, but nothing read return } } return -code error -errorcode [list POSIX ENOENT {}] } | | | | | < < < < | > < < < | | | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | # Success, but nothing read return } } return -code error -errorcode [list POSIX ENOENT {}] } proc fs_release {context path fileinfo} { log "release $path" if {[info exists ::T($path)]} { lassign $::T($path) nodeid clspath # Decrement use counter for cache entry. incr ::U($nodeid) -1 } return } proc fs_destroy {context} { log "shutdown, disconnecting" catch {opcua disconnect C} log "exiting" exit 0 } # Create and serve fuse file system fuse create FS \ -getattr fs_getattr \ -readdir fs_readdir \ -open fs_open \ -read fs_read \ -release fs_release \ -destroy fs_destroy FS $mountpoint -s -ononempty -ofsname=OPCUA log "created/mounted file system" # Remove old cache entries after 60 seconds # and do some keep-alive/reconnect handling. proc fs_cleanup {url} { log "cleanup ..." set status /Root/Objects/Server/ServerStatus if {[info exists ::T($status)]} { if {[catch {opcua read C [lindex $::T($status) 0]} error]} { log "reading server status: $error" catch {opcua disconnect C} log "reconnecting to $url" if {[catch {opcua connect C $url} error]} { log "connect failed: $error" } } } set now [clock seconds] foreach nodeid [array names ::D] { if {$::U($nodeid) <= 0 && $now - $::M($nodeid) >= 60} { log "expire $::R($nodeid)" unset -nocomplain ::D($nodeid) unset -nocomplain ::M($nodeid) unset -nocomplain ::U($nodeid) } } after 10000 [list fs_cleanup $url] } fs_cleanup $url # Start event loop log "enter event loop" vwait forever |