Check-in [b0632ecbad]
Not logged in

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: b0632ecbad0d335ef7f7fc296285803ec54a4821
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
Unified Diff Ignore Whitespace Patch
Deleted jni/sdl2tk/README.
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
README:  Tk
    This is the Tk 8.6.9 source distribution.
	http://sourceforge.net/projects/tcl/files/Tcl/
    You can get any source release of Tk from the URL above.

1. Introduction
---------------

This directory contains the sources and documentation for Tk, an X11
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 at

	http://www.tcl-lang.org/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:

	http://core.tcl-lang.org/tk/

with the Tcl Developer Xchange at:

	http://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.

2. See Tcl README
-----------------

Please see the README 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.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































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
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] == "win"} {
   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 {







|







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
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 \
		$(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







|







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.
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
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
README:  Tcl
    This is the Tcl 8.6.9 source distribution.
	http://sourceforge.net/projects/tcl/files/Tcl/
    You can get any source release of Tcl from the URL above.

Contents
--------
    1. Introduction
    2. Documentation
    3. Compiling and installing Tcl
    4. Development tools
    5. Tcl newsgroup
    6. The Tcler's Wiki
    7. Mailing lists
    8. Support and Training
    9. Tracking Development
    10. Thank You

1. 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:

	http://core.tcl-lang.org/

Tcl/Tk release and mailing list services are hosted by SourceForge:

	http://sourceforge.net/projects/tcl/

with the Tcl Developer Xchange hosted at:

	http://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.

2. Documentation
----------------

Extensive documentation is available at our website.
The home page for this release, including new features, is
	http://www.tcl-lang.org/software/tcltk/8.6.html

Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
	http://sourceforge.net/projects/tcl/files/Tcl/

Information about Tcl itself can be found at
	http://www.tcl-lang.org/about/

There have been many Tcl books on the market.  Many are mentioned in the Wiki:
	http://wiki.tcl-lang.org/_/ref?N=25206

To view the complete set of reference manual entries for Tcl 8.6 online,
visit the URL:
	http://www.tcl-lang.org/man/tcl8.6/

2a. 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

		ditroff -man Tcl.n

to print Tcl.n.  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

2b. 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

3. 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 at

	http://www.tcl-lang.org/doc/howto/compile.html

4. 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

5. 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.

6. Tcl'ers Wiki
---------------

A Wiki-based open community site covering all aspects of Tcl/Tk is at:

	http://wiki.tcl-lang.org/

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.

7. 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:

	http://sourceforge.net/projects/tcl/

and go to the Mailing Lists page.

8. 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 tracker at:

	http://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.  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 following Web site for links to other organizations that offer
Tcl/Tk training:

	http://wiki.tcl-lang.org/training

9. Tracking Development
-----------------------

Tcl is developed in public.  To keep an eye on how Tcl is changing, see
	http://core.tcl-lang.org/

10. 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.
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































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
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.







|







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
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];
		}







|







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
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;
	}







|







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
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;








|







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
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,







|
|







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
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








|




|







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
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
 *







|







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
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
 *







|

|







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
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
 *







|







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
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;








|







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
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;
}

/*







|







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
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.







|







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
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);
}
/*







|







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
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







|


|

|



|

|


|







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
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.







|







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
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 {







|




|







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
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 \
		$(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 \







|







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
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
}

# 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.



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 ::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]} {

	    # Fetch Value attribute into cache

	    if {![info exists ::D($nodeid)]} {


		if {[catch {set ::D($nodeid) [opcua read C $nodeid]}]} {
		    return -code error -errorcode [list POSIX EIO {}]
		}
		set ::M($nodeid) [clock seconds]

	    }
	    return [dict create mode 0444 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: empty return
	    incr ::U($nodeid)
	    return
	}

    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_readdir {context path fileinfo} {
    log "readdir $path"
    if {[info exists ::T($path)]} {







|
>
>













>
>
>
>
>
>
>
>
>
>


















>
|
>
|
>
>



|
>

|


















|



>







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
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
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
	    # Success, but nothing read
	    return
	}
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_flush {context path fileinfo} {
    log "flush $path"
    if {[info exists ::T($path)]} {
	lassign $::T($path) nodeid clspath
	# Cleanup cached Value attribute, if any
	if {[incr ::U($nodeid) -1] <= 0} {
	    unset -nocomplain ::D($nodeid)
	    unset -nocomplain ::M($nodeid)
	    unset -nocomplain ::U($nodeid)
	}
    }
    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 \
    -flush fs_flush \
    -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} {

    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 {[info exists ::U($nodeid)]} {
	    continue
	}
	if {$now - $::M($nodeid) > 60} {
	    log "expire $::R($nodeid)"
	    unset -nocomplain ::D($nodeid)
	    unset -nocomplain ::M($nodeid)
	    unset -nocomplain ::U($nodeid)
	}
    }
    after 15000 [list fs_cleanup $url]
}

fs_cleanup $url

# Start event loop

log "enter event loop"
vwait forever







|
|


|
|
<
<
<
<


















|









>













<
<
<
|






|








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