Tcl Source Code

Check-in [e4761eb0a8]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Backport "registry" version 1.3.3, so all active branches now have the same registry version. (this commit must -eventually- be merge-marked to core-8-6-branch, since everything is there already)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA3-256: e4761eb0a8434af30ea554566d851b67ae0ac920889482c323d18ef6fcd70549
User & Date: jan.nijtmans 2018-10-24 21:22:18
Context
2018-10-27
07:53
tclWinDde.c: Backport version 1.4.1 from Tcl 8.6. check-in: 714f445acf user: jan.nijtmans tags: core-8-5-branch
2018-10-24
21:22
Backport "registry" version 1.3.3, so all active branches now have the same registry version. (this... check-in: e4761eb0a8 user: jan.nijtmans tags: core-8-5-branch
2018-10-23
11:14
Enable CI builds with Travis. check-in: 0386db909a user: dkf tags: core-8-5-branch
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to library/reg/pkgIndex.tcl.

     1      1   if {![package vsatisfies [package provide Tcl] 8]} return
     2      2   if {[info sharedlibextension] != ".dll"} return
     3      3   if {[info exists ::tcl_platform(debug)]} {
     4         -    package ifneeded registry 1.2.2 \
     5         -            [list load [file join $dir tclreg12g.dll] registry]
            4  +    package ifneeded registry 1.3.3 \
            5  +            [list load [file join $dir tclreg13g.dll] registry]
     6      6   } else {
     7         -    package ifneeded registry 1.2.2 \
     8         -            [list load [file join $dir tclreg12.dll] registry]
            7  +    package ifneeded registry 1.3.3 \
            8  +            [list load [file join $dir tclreg13.dll] registry]
     9      9   }

Changes to tests/registry.test.

    15     15       namespace import -force ::tcltest::*
    16     16   }
    17     17   
    18     18   testConstraint reg 0
    19     19   if {[testConstraint win]} {
    20     20       if {![catch {
    21     21   	    ::tcltest::loadTestedCommands
    22         -	    package require registry
           22  +	    set ::regver [package require registry 1.3.3]
    23     23   	}]} {
    24     24   	testConstraint reg 1
    25     25       }
    26     26   }
    27     27   
    28     28   # determine the current locale
    29     29   testConstraint english [expr {
    30     30       [llength [info commands testlocale]]
    31     31       && [string match "English*" [testlocale all ""]]
    32     32   }]
    33         -
           33  +
           34  +test registry-1.0 {check if we are testing the right dll} {win reg} {
           35  +    set ::regver
           36  +} {1.3.3}
    34     37   test registry-1.1 {argument parsing for registry command} {win reg} {
    35     38       list [catch {registry} msg] $msg
    36         -} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
           39  +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
           40  +test registry-1.1a {argument parsing for registry command} {win reg} {
           41  +    list [catch {registry -32bit} msg] $msg
           42  +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
           43  +test registry-1.1b {argument parsing for registry command} {win reg} {
           44  +    list [catch {registry -64bit} msg] $msg
           45  +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
    37     46   test registry-1.2 {argument parsing for registry command} {win reg} {
    38     47       list [catch {registry foo} msg] $msg
    39     48   } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}}
           49  +test registry-1.2a {argument parsing for registry command} {win reg} {
           50  +    list [catch {registry -33bit foo} msg] $msg
           51  +} {1 {bad mode "-33bit": must be -32bit or -64bit}}
    40     52   
    41     53   test registry-1.3 {argument parsing for registry command} {win reg} {
    42     54       list [catch {registry d} msg] $msg
    43     55   } {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
           56  +test registry-1.3a {argument parsing for registry command} {win reg} {
           57  +    list [catch {registry -32bit d} msg] $msg
           58  +} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}}
           59  +test registry-1.3b {argument parsing for registry command} {win reg} {
           60  +    list [catch {registry -64bit d} msg] $msg
           61  +} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}}
    44     62   test registry-1.4 {argument parsing for registry command} {win reg} {
    45     63       list [catch {registry delete} msg] $msg
    46     64   } {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
    47     65   test registry-1.5 {argument parsing for registry command} {win reg} {
    48     66       list [catch {registry delete foo bar baz} msg] $msg
    49     67   } {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
    50     68   
    51     69   test registry-1.6 {argument parsing for registry command} {win reg} {
    52     70       list [catch {registry g} msg] $msg
    53     71   } {1 {wrong # args: should be "registry get keyName valueName"}}
           72  +test registry-1.6a {argument parsing for registry command} {win reg} {
           73  +    list [catch {registry -32bit g} msg] $msg
           74  +} {1 {wrong # args: should be "registry -32bit get keyName valueName"}}
           75  +test registry-1.6b {argument parsing for registry command} {win reg} {
           76  +    list [catch {registry -64bit g} msg] $msg
           77  +} {1 {wrong # args: should be "registry -64bit get keyName valueName"}}
    54     78   test registry-1.7 {argument parsing for registry command} {win reg} {
    55     79       list [catch {registry get} msg] $msg
    56     80   } {1 {wrong # args: should be "registry get keyName valueName"}}
    57     81   test registry-1.8 {argument parsing for registry command} {win reg} {
    58     82       list [catch {registry get foo} msg] $msg
    59     83   } {1 {wrong # args: should be "registry get keyName valueName"}}
    60     84   test registry-1.9 {argument parsing for registry command} {win reg} {
    61     85       list [catch {registry get foo bar baz} msg] $msg
    62     86   } {1 {wrong # args: should be "registry get keyName valueName"}}
    63     87   
    64     88   test registry-1.10 {argument parsing for registry command} {win reg} {
    65     89       list [catch {registry k} msg] $msg
    66     90   } {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
           91  +test registry-1.10a {argument parsing for registry command} {win reg} {
           92  +    list [catch {registry -32bit k} msg] $msg
           93  +} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}}
           94  +test registry-1.10b {argument parsing for registry command} {win reg} {
           95  +    list [catch {registry -64bit k} msg] $msg
           96  +} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}}
    67     97   test registry-1.11 {argument parsing for registry command} {win reg} {
    68     98       list [catch {registry keys} msg] $msg
    69     99   } {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
    70    100   test registry-1.12 {argument parsing for registry command} {win reg} {
    71    101       list [catch {registry keys foo bar baz} msg] $msg
    72    102   } {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
    73    103   
    74    104   test registry-1.13 {argument parsing for registry command} {win reg} {
    75    105       list [catch {registry s} msg] $msg
    76    106   } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
          107  +test registry-1.13a {argument parsing for registry command} {win reg} {
          108  +    list [catch {registry -32bit s} msg] $msg
          109  +} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}}
          110  +test registry-1.13b {argument parsing for registry command} {win reg} {
          111  +    list [catch {registry -64bit s} msg] $msg
          112  +} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}}
    77    113   test registry-1.14 {argument parsing for registry command} {win reg} {
    78    114       list [catch {registry set} msg] $msg
    79    115   } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
    80    116   test registry-1.15 {argument parsing for registry command} {win reg} {
    81    117       list [catch {registry set foo bar} msg] $msg
    82    118   } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
    83    119   test registry-1.16 {argument parsing for registry command} {win reg} {
    84    120       list [catch {registry set foo bar baz blat gorp} msg] $msg
    85    121   } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
    86    122   
    87    123   test registry-1.17 {argument parsing for registry command} {win reg} {
    88    124       list [catch {registry t} msg] $msg
    89    125   } {1 {wrong # args: should be "registry type keyName valueName"}}
          126  +test registry-1.17a {argument parsing for registry command} {win reg} {
          127  +    list [catch {registry -32bit t} msg] $msg
          128  +} {1 {wrong # args: should be "registry -32bit type keyName valueName"}}
          129  +test registry-1.17b {argument parsing for registry command} {win reg} {
          130  +    list [catch {registry -64bit t} msg] $msg
          131  +} {1 {wrong # args: should be "registry -64bit type keyName valueName"}}
    90    132   test registry-1.18 {argument parsing for registry command} {win reg} {
    91    133       list [catch {registry type} msg] $msg
    92    134   } {1 {wrong # args: should be "registry type keyName valueName"}}
    93    135   test registry-1.19 {argument parsing for registry command} {win reg} {
    94    136       list [catch {registry type foo} msg] $msg
    95    137   } {1 {wrong # args: should be "registry type keyName valueName"}}
    96    138   test registry-1.20 {argument parsing for registry command} {win reg} {
    97    139       list [catch {registry type foo bar baz} msg] $msg
    98    140   } {1 {wrong # args: should be "registry type keyName valueName"}}
    99    141   
   100    142   test registry-1.21 {argument parsing for registry command} {win reg} {
   101    143       list [catch {registry v} msg] $msg
   102    144   } {1 {wrong # args: should be "registry values keyName ?pattern?"}}
          145  +test registry-1.21a {argument parsing for registry command} {win reg} {
          146  +    list [catch {registry -32bit v} msg] $msg
          147  +} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}}
          148  +test registry-1.21b {argument parsing for registry command} {win reg} {
          149  +    list [catch {registry -64bit v} msg] $msg
          150  +} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}}
   103    151   test registry-1.22 {argument parsing for registry command} {win reg} {
   104    152       list [catch {registry values} msg] $msg
   105    153   } {1 {wrong # args: should be "registry values keyName ?pattern?"}}
   106    154   test registry-1.23 {argument parsing for registry command} {win reg} {
   107    155       list [catch {registry values foo bar baz} msg] $msg
   108    156   } {1 {wrong # args: should be "registry values keyName ?pattern?"}}
   109    157   
   110    158   test registry-2.1 {DeleteKey: bad key} {win reg} {
   111    159       list [catch {registry delete foo} msg] $msg
   112    160   } {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
   113    161   test registry-2.2 {DeleteKey: bad key} {win reg} {
   114         -    list [catch {registry delete HKEY_CURRENT_USER} msg] $msg
          162  +    list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg
   115    163   } {1 {bad key: cannot delete root keys}}
   116    164   test registry-2.3 {DeleteKey: bad key} {win reg} {
   117         -    list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg
          165  +    list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
   118    166   } {1 {bad key: cannot delete root keys}}
   119    167   test registry-2.4 {DeleteKey: subkey at root level} {win reg} {
   120    168       registry set HKEY_CURRENT_USER\\TclFoobar
   121    169       registry delete HKEY_CURRENT_USER\\TclFoobar
   122    170       registry keys HKEY_CURRENT_USER TclFoobar
   123    171   } {}
   124    172   test registry-2.5 {DeleteKey: subkey below root level} {win reg} {
................................................................................
   231    279       registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar
   232    280       registry set HKEY_CURRENT_USER\\TclFoobar\\blat
   233    281       registry set HKEY_CURRENT_USER\\TclFoobar\\foo
   234    282       set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
   235    283       registry delete HKEY_CURRENT_USER\\TclFoobar
   236    284       set result
   237    285   } "baz\u00c7bar blat"
   238         -test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
          286  +test registry-4.8 {GetKeyNames: Unicode} {win reg} {
   239    287       registry delete HKEY_CURRENT_USER\\TclFoobar
   240    288       registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
   241    289       registry set HKEY_CURRENT_USER\\TclFoobar\\blat
   242    290       registry set HKEY_CURRENT_USER\\TclFoobar\\foo
   243    291       set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
   244    292       registry delete HKEY_CURRENT_USER\\TclFoobar
   245    293       set result
................................................................................
   435    483   } 1
   436    484   test registry-6.17 {GetValue: Unicode value names} {win reg} {
   437    485       registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz
   438    486       set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71]
   439    487       registry delete HKEY_CURRENT_USER\\TclFoobar
   440    488       set result
   441    489   } foobar
   442         -test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
          490  +test registry-6.18 {GetValue: values with Unicode strings} {win reg} {
   443    491       registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
   444    492       set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
   445    493       registry delete HKEY_CURRENT_USER\\TclFoobar
   446    494       set result
   447    495   } "foo ba\u30b7r baz"
   448    496   test registry-6.19 {GetValue: values with Unicode strings} {win reg english} {
   449    497       registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
................................................................................
   453    501   } "foo ba\u00c7r baz"
   454    502   test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} {
   455    503       registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
   456    504       set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
   457    505       registry delete HKEY_CURRENT_USER\\TclFoobar
   458    506       set result
   459    507   } "foo ba r baz"
   460         -test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
   461         -    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 199] [string repeat x 199] multi_sz
   462         -    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 199]]
          508  +test registry-6.21 {GetValue: very long value names and values} {win reg} {
          509  +    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
          510  +    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
   463    511       registry delete HKEY_CURRENT_USER\\TclFoobar
   464    512       set result
   465         -} [string repeat x 199]
          513  +} [string repeat x 16383]
   466    514   
   467         -test registry-7.1 {GetValueNames: bad key} {win reg english} {
          515  +test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
   468    516       registry delete HKEY_CURRENT_USER\\TclFoobar
   469         -    list [catch {registry values HKEY_CURRENT_USER\\TclFoobar} msg] $msg
   470         -} {1 {unable to open key: The system cannot find the file specified.}}
   471         -test registry-7.2 {GetValueNames} {win reg} {
          517  +} -body {
          518  +    registry values HKEY_CURRENT_USER\\TclFoobar
          519  +} -returnCodes error -result {unable to open key: The system cannot find the file specified.}
          520  +test registry-7.2 {GetValueNames} -constraints {win reg} -setup {
   472    521       registry delete HKEY_CURRENT_USER\\TclFoobar
   473    522       registry set HKEY_CURRENT_USER\\TclFoobar baz foobar
   474         -    set result [registry values HKEY_CURRENT_USER\\TclFoobar]
          523  +} -body {
          524  +    registry values HKEY_CURRENT_USER\\TclFoobar
          525  +} -cleanup {
   475    526       registry delete HKEY_CURRENT_USER\\TclFoobar
   476         -    set result
   477         -} baz
   478         -test registry-7.3 {GetValueNames} {win reg} {
          527  +} -result baz
          528  +test registry-7.3 {GetValueNames} -constraints {win reg} -setup {
   479    529       registry delete HKEY_CURRENT_USER\\TclFoobar
   480    530       registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
   481    531       registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
   482    532       registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3
   483         -    set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar]]
          533  +} -body {
          534  +    lsort [registry values HKEY_CURRENT_USER\\TclFoobar]
          535  +} -cleanup {
   484    536       registry delete HKEY_CURRENT_USER\\TclFoobar
   485         -    set result
   486         -} {{} baz blat}
   487         -test registry-7.4 {GetValueNames: remote key} {win reg nonPortable english} {
          537  +} -result {{} baz blat}
          538  +test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body {
   488    539       set hostname [info hostname]
   489    540       registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat
   490    541       set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar]
   491    542       registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
   492    543       set result
   493         -} baz
   494         -test registry-7.5 {GetValueNames: empty key} {win reg} {
          544  +} -result baz
          545  +test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup {
   495    546       registry delete HKEY_CURRENT_USER\\TclFoobar
   496    547       registry set HKEY_CURRENT_USER\\TclFoobar
   497         -    set result [registry values HKEY_CURRENT_USER\\TclFoobar]
          548  +} -body {
          549  +    registry values HKEY_CURRENT_USER\\TclFoobar
          550  +} -cleanup {
   498    551       registry delete HKEY_CURRENT_USER\\TclFoobar
   499         -    set result
   500         -} {}
   501         -test registry-7.6 {GetValueNames: patterns} {win reg} {
          552  +} -result {}
          553  +test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup {
   502    554       registry delete HKEY_CURRENT_USER\\TclFoobar
   503    555       registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
   504    556       registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
   505    557       registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3
   506         -    set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]]
          558  +} -body {
          559  +    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
          560  +} -cleanup {
   507    561       registry delete HKEY_CURRENT_USER\\TclFoobar
   508         -    set result
   509         -} {baz blat}
   510         -test registry-7.7 {GetValueNames: names with spaces} {win reg} {
          562  +} -result {baz blat}
          563  +test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup {
   511    564       registry delete HKEY_CURRENT_USER\\TclFoobar
   512    565       registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1
   513    566       registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
   514    567       registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3
   515         -    set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]]
          568  +} -body {
          569  +    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
          570  +} -cleanup {
   516    571       registry delete HKEY_CURRENT_USER\\TclFoobar
   517         -    set result
   518         -} {{baz bar} blat}
          572  +} -result {{baz bar} blat}
   519    573   
   520         -test registry-8.1 {OpenSubKey} {win reg nonPortable english} {
   521         -    # This test will only succeed if the current user does not have registry
   522         -    # access on the specified machine.
   523         -    list [catch {registry keys {\\mom\HKEY_LOCAL_MACHINE}} msg] $msg
   524         -} {1 {unable to open key: Access is denied.}}
   525         -test registry-8.2 {OpenSubKey} {win reg} {
          574  +test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \
          575  +    -body {
          576  +        # This test will only succeed if the current user does not have
          577  +        # registry access on the specified machine.
          578  +        registry keys {\\mom\HKEY_LOCAL_MACHINE}
          579  +    } -returnCodes error -result "unable to open key: Access is denied."
          580  +test registry-8.2 {OpenSubKey} -constraints {win reg} -setup {
   526    581       registry delete HKEY_CURRENT_USER\\TclFoobar
   527    582       registry set HKEY_CURRENT_USER\\TclFoobar
   528         -    set result [registry keys HKEY_CURRENT_USER TclFoobar]
          583  +} -body {
          584  +    registry keys HKEY_CURRENT_USER TclFoobar
          585  +} -cleanup {
   529    586       registry delete HKEY_CURRENT_USER\\TclFoobar
   530         -    set result
   531         -} TclFoobar
   532         -test registry-8.3 {OpenSubKey} {win reg english} {
          587  +} -result {TclFoobar}
          588  +test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup {
   533    589       registry delete HKEY_CURRENT_USER\\TclFoobar
   534         -    list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar} msg] $msg
   535         -} {1 {unable to open key: The system cannot find the file specified.}}
          590  +} -body {
          591  +    registry keys HKEY_CURRENT_USER\\TclFoobar
          592  +} -returnCodes error \
          593  +    -result "unable to open key: The system cannot find the file specified."
   536    594   
   537         -test registry-9.1 {ParseKeyName: bad keys} {win reg} {
   538         -    list [catch {registry values \\} msg] $msg
   539         -} "1 {bad key \"\\\": must start with a valid root}"
   540         -test registry-9.2 {ParseKeyName: bad keys} {win reg} {
   541         -    list [catch {registry values \\foobar} msg] $msg
   542         -} {1 {bad key "\foobar": must start with a valid root}}
   543         -test registry-9.3 {ParseKeyName: bad keys} {win reg} {
   544         -    list [catch {registry values \\\\} msg] $msg
   545         -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
   546         -test registry-9.4 {ParseKeyName: bad keys} {win reg} {
   547         -    list [catch {registry values \\\\\\} msg] $msg
   548         -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
   549         -test registry-9.5 {ParseKeyName: bad keys} {win reg english nt} {
   550         -    list [catch {registry values \\\\\\HKEY_CURRENT_USER} msg] $msg
   551         -} {1 {unable to open key: The network address is invalid.}}
   552         -test registry-9.6 {ParseKeyName: bad keys} {win reg} {
   553         -    list [catch {registry values \\\\gaspode} msg] $msg
   554         -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
   555         -test registry-9.7 {ParseKeyName: bad keys} {win reg} {
   556         -    list [catch {registry values foobar} msg] $msg
   557         -} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
   558         -test registry-9.8 {ParseKeyName: null keys} {win reg} {
   559         -    list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg
   560         -} {1 {bad key: cannot delete root keys}}
   561         -test registry-9.9 {ParseKeyName: null keys} {win reg english} {
   562         -    list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar\\baz} msg] $msg
   563         -} {1 {unable to open key: The system cannot find the file specified.}}
          595  +test registry-9.1 {ParseKeyName: bad keys} -constraints {win reg} -body {
          596  +    registry values \\
          597  +} -returnCodes error -result "bad key \"\\\": must start with a valid root"
          598  +test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body {
          599  +    registry values \\foobar
          600  +} -returnCodes error -result {bad key "\foobar": must start with a valid root}
          601  +test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
          602  +    registry values \\\\
          603  +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
          604  +test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
          605  +    registry values \\\\\\
          606  +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
          607  +test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body {
          608  +    registry values \\\\\\HKEY_CLASSES_ROOT
          609  +} -returnCodes error -result {unable to open key: The network address is invalid.}
          610  +test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
          611  +    registry values \\\\gaspode
          612  +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
          613  +test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body {
          614  +    registry values foobar
          615  +} -returnCodes error -result {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
          616  +test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body {
          617  +    registry delete HKEY_CLASSES_ROOT\\
          618  +} -returnCodes error -result {bad key: cannot delete root keys}
          619  +test registry-9.9 {ParseKeyName: null keys} \
          620  +    -constraints {win reg english} \
          621  +    -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \
          622  +    -returnCodes error \
          623  +    -result {unable to open key: The system cannot find the file specified.}
   564    624   
   565         -test registry-10.1 {RecursiveDeleteKey} {win reg} {
          625  +test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup {
   566    626       registry delete HKEY_CURRENT_USER\\TclFoobar
          627  +} -body {
   567    628       registry set HKEY_CURRENT_USER\\TclFoobar\\test1
   568    629       registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
   569    630       registry delete HKEY_CURRENT_USER\\TclFoobar
   570    631       set result [registry keys HKEY_CURRENT_USER TclFoobar]
   571    632       set result
   572         -} {}
   573         -test registry-10.2 {RecursiveDeleteKey} {win reg} {
          633  +} -result {}
          634  +test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup {
   574    635       registry delete HKEY_CURRENT_USER\\TclFoobar
   575    636       registry set HKEY_CURRENT_USER\\TclFoobar\\test1
   576    637       registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
   577         -    set result [registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4]
          638  +} -body {
          639  +    registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4
          640  +} -cleanup {
   578    641       registry delete HKEY_CURRENT_USER\\TclFoobar
   579         -    set result
   580         -} {}
          642  +} -result {}
   581    643   
   582         -test registry-11.1 {SetValue: recursive creation} {win reg} {
   583         -    registry delete HKEY_CURRENT_USER\\TclFoobar
   584         -    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
   585         -    set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
   586         -} foobar
   587         -test registry-11.2 {SetValue: modification} {win reg} {
   588         -    registry delete HKEY_CURRENT_USER\\TclFoobar
   589         -    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
   590         -    registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob
   591         -    set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
   592         -} frob
   593         -test registry-11.3 {SetValue: failure} {win reg nonPortable english} {
   594         -    # This test will only succeed if the current user does not have registry
   595         -    # access on the specified machine.
   596         -    list [catch {registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar} msg] $msg
   597         -} {1 {unable to open key: Access is denied.}}
          644  +test registry-11.1 {SetValue: recursive creation} \
          645  +    -constraints {win reg} -setup {
          646  +        registry delete HKEY_CURRENT_USER\\TclFoobar
          647  +    } -body {
          648  +        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
          649  +        set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
          650  +    } -result {foobar}
          651  +test registry-11.2 {SetValue: modification} -constraints {win reg} \
          652  +    -setup {
          653  +        registry delete HKEY_CURRENT_USER\\TclFoobar
          654  +    } -body {
          655  +        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
          656  +        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob
          657  +        set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
          658  +    } -result {frob}
          659  +test registry-11.3 {SetValue: failure} \
          660  +    -constraints {win reg nonPortable english} \
          661  +    -body {
          662  +        # This test will only succeed if the current user does not have
          663  +        # registry access on the specified machine.
          664  +        registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar
          665  +    } -returnCodes error -result {unable to open key: Access is denied.}
   598    666   
   599         -test registry-12.1 {BroadcastValue} {win reg} {
   600         -    list [catch {registry broadcast} msg] $msg
   601         -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
   602         -test registry-12.2 {BroadcastValue} {win reg} {
   603         -    list [catch {registry broadcast "" -time} msg] $msg
   604         -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
   605         -test registry-12.3 {BroadcastValue} {win reg} {
   606         -    list [catch {registry broadcast "" - 500} msg] $msg
   607         -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
   608         -test registry-12.4 {BroadcastValue} {win reg} {
   609         -    list [catch {registry broadcast {Environment}} msg] $msg
   610         -} {0 {1 0}}
   611         -test registry-12.5 {BroadcastValue} {win reg} {
   612         -    list [catch {registry b {}} msg] $msg
   613         -} {0 {1 0}}
   614         -
          667  +test registry-12.1 {BroadcastValue} -constraints {win reg} -body {
          668  +    registry broadcast
          669  +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
          670  +test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
          671  +    registry broadcast "" -time
          672  +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
          673  +test registry-12.3 {BroadcastValue} -constraints {win reg} -body {
          674  +    registry broadcast "" - 500
          675  +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
          676  +test registry-12.4 {BroadcastValue} -constraints {win reg} -body {
          677  +    registry broadcast {Environment}
          678  +} -result {1 0}
          679  +test registry-12.5 {BroadcastValue} -constraints {win reg} -body {
          680  +    registry b {}
          681  +} -result {1 0}
          682  +
   615    683   # cleanup
   616    684   ::tcltest::cleanupTests
   617    685   return
   618    686   
   619    687   # Local Variables:
   620    688   # mode: tcl
   621    689   # tcl-indent-level: 4
   622    690   # fill-column: 78
   623    691   # End:

Changes to win/Makefile.in.

   491    491   
   492    492   tclAppInit.${OBJEXT} : tclAppInit.c
   493    493   	$(CC) -c $(CC_SWITCHES) @[email protected] $(CC_OBJNAME)
   494    494   
   495    495   # The following objects should be built using the stub interfaces
   496    496   
   497    497   tclWinReg.${OBJEXT} : tclWinReg.c
   498         -	$(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME)
          498  +	$(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME)
   499    499   
   500    500   tclWinDde.${OBJEXT} : tclWinDde.c
   501    501   	$(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME)
   502    502   
   503    503   # TIP #59, embedding of configuration information into the binary library.
   504    504   #
   505    505   # Part of Tcl's configuration information are the paths where it was installed
................................................................................
   706    706   # tcltest, i.e.:
   707    707   #	% make test TESTFLAGS="-verbose bps -file fileName.test"
   708    708   
   709    709   test: binaries $(TCLTEST)
   710    710   	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
   711    711   	./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
   712    712   	-load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
   713         -	package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
          713  +	package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
   714    714   
   715    715   # Useful target to launch a built tcltest with the proper path,...
   716    716   runtest: binaries $(TCLTEST)
   717    717   	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
   718    718   	./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
   719         -	package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
          719  +	package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
   720    720   
   721    721   # This target can be used to run tclsh from the build directory via
   722    722   # `make shell SCRIPT=foo.tcl`
   723    723   shell: binaries
   724    724   	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
   725    725   	./$(TCLSH) $(SCRIPT)
   726    726   

Changes to win/configure.in.

    18     18   VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
    19     19   
    20     20   TCL_DDE_VERSION=1.3
    21     21   TCL_DDE_MAJOR_VERSION=1
    22     22   TCL_DDE_MINOR_VERSION=3
    23     23   DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
    24     24   
    25         -TCL_REG_VERSION=1.2
           25  +TCL_REG_VERSION=1.3
    26     26   TCL_REG_MAJOR_VERSION=1
    27         -TCL_REG_MINOR_VERSION=2
           27  +TCL_REG_MINOR_VERSION=3
    28     28   REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
    29     29   
    30     30   #------------------------------------------------------------------------
    31     31   # Handle the --prefix=... option
    32     32   #------------------------------------------------------------------------
    33     33   
    34     34   if test "${prefix}" = "NONE"; then

Changes to win/makefile.bc.

   126    126   STUBPREFIX	= $(NAMEPREFIX)stub
   127    127   DOTVERSION	= 8.5
   128    128   VERSION		= 85
   129    129   
   130    130   DDEVERSION = 13
   131    131   DDEDOTVERSION = 1.3
   132    132   
   133         -REGVERSION = 12
   134         -REGDOTVERSION = 1.2
          133  +REGVERSION = 13
          134  +REGDOTVERSION = 1.3
   135    135   
   136    136   BINROOT		= ..
   137    137   !IF "$(NODEBUG)" == "1"
   138    138   TMPDIRNAME	= Release
   139    139   DBGX		=
   140    140   SYMDEFINES	= -DNDEBUG
   141    141   !ELSE

Changes to win/makefile.vc.

   181    181   STUBPREFIX      = $(PROJECT)stub
   182    182   DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
   183    183   VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
   184    184   
   185    185   DDEDOTVERSION = 1.3
   186    186   DDEVERSION = $(DDEDOTVERSION:.=)
   187    187   
   188         -REGDOTVERSION = 1.2
          188  +REGDOTVERSION = 1.3
   189    189   REGVERSION = $(REGDOTVERSION:.=)
   190    190   
   191    191   BINROOT		= .
   192    192   ROOT		= ..
   193    193   
   194    194   TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
   195    195   TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
................................................................................
   535    535   
   536    536   test: test-core
   537    537   test-core: setup $(TCLTEST) dlls $(CAT32)
   538    538   	set TCL_LIBRARY=$(ROOT:\=/)/library
   539    539   !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
   540    540   	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
   541    541   		package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde]
   542         -		package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry]
          542  +		package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
   543    543   <<
   544    544   !else
   545    545   	@echo Please wait while the tests are collected...
   546    546   	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
   547    547   		package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde]
   548         -		package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry]
          548  +		package ifneeded registry 1.3.3 "$(TCLREGLIB:\=/)" registry]
   549    549   <<
   550    550   	type tests.log | more
   551    551   !endif
   552    552   
   553    553   runtest: setup $(TCLTEST) dlls $(CAT32)
   554    554   	set TCL_LIBRARY=$(ROOT:\=/)/library
   555    555   	$(DEBUGGER) $(TCLTEST) $(SCRIPT)
................................................................................
   881    881   	    [email protected] $?
   882    882   
   883    883   ### The following objects should be built using the stub interfaces
   884    884   ### *ALL* extensions need to built with -DTCL_THREADS=1
   885    885   
   886    886   $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
   887    887   !if $(STATIC_BUILD)
   888         -	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD [email protected] $?
          888  +	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE [email protected] $?
   889    889   !else
   890         -	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS [email protected] $?
          890  +	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -DUNICODE -D_UNICODE [email protected] $?
   891    891   !endif
   892    892   
   893    893   
   894    894   $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
   895    895   !if $(STATIC_BUILD)
   896    896   	$(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD [email protected] $?
   897    897   !else

Changes to win/rules.vc.

   586    586   TCLSH		= "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
   587    587   !if !exist($(TCLSH)) && $(TCL_THREADS)
   588    588   TCLSH           = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
   589    589   !endif
   590    590   TCLSTUBLIB	= "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
   591    591   TCLIMPLIB	= "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
   592    592   TCL_LIBRARY	= $(_TCLDIR)\lib
   593         -TCLREGLIB	= "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib"
          593  +TCLREGLIB	= "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
   594    594   TCLDDELIB	= "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib"
   595    595   COFFBASE	= \must\have\tcl\sources\to\build\this\target
   596    596   TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
   597    597   TCL_INCLUDES    = -I"$(_TCLDIR)\include"
   598    598   !else
   599    599   TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
   600    600   !if !exist($(TCLSH)) && $(TCL_THREADS)
   601    601   TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
   602    602   !endif
   603    603   TCLSTUBLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
   604    604   TCLIMPLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
   605    605   TCL_LIBRARY	= $(_TCLDIR)\library
   606         -TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
          606  +TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
   607    607   TCLDDELIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
   608    608   COFFBASE	= "$(_TCLDIR)\win\coffbase.txt"
   609    609   TCLTOOLSDIR	= $(_TCLDIR)\tools
   610    610   TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
   611    611   !endif
   612    612   
   613    613   !endif

Changes to win/tclWinReg.c.

     8      8    * Copyright (c) 1997 by Sun Microsystems, Inc.
     9      9    * Copyright (c) 1998-1999 by Scriptics Corporation.
    10     10    *
    11     11    * See the file "license.terms" for information on usage and redistribution of
    12     12    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13    */
    14     14   
           15  +#undef STATIC_BUILD
           16  +#ifndef USE_TCL_STUBS
           17  +#   define USE_TCL_STUBS
           18  +#endif
    15     19   #include "tclInt.h"
    16         -#include "tclPort.h"
    17     20   #ifdef _MSC_VER
    18     21   #   pragma comment (lib, "advapi32.lib")
    19     22   #endif
    20     23   #include <stdlib.h>
    21     24   
    22     25   /*
    23         - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
    24         - * Registry_Init declaration is in the source file itself, which is only
    25         - * accessed when we are building a library.
           26  + * Ensure that we can say which registry is being accessed.
    26     27    */
    27     28   
    28         -#undef TCL_STORAGE_CLASS
    29         -#define TCL_STORAGE_CLASS DLLEXPORT
           29  +#ifndef KEY_WOW64_64KEY
           30  +#   define KEY_WOW64_64KEY	(0x0100)
           31  +#endif
           32  +#ifndef KEY_WOW64_32KEY
           33  +#   define KEY_WOW64_32KEY	(0x0200)
           34  +#endif
    30     35   
    31     36   /*
    32     37    * The maximum length of a sub-key name.
    33     38    */
    34     39   
    35     40   #ifndef MAX_KEY_LENGTH
    36         -#define MAX_KEY_LENGTH		256
           41  +#   define MAX_KEY_LENGTH	256
    37     42   #endif
    38     43   
    39     44   /*
    40     45    * The following macros convert between different endian ints.
    41     46    */
    42     47   
    43         -#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x))
    44         -#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
           48  +#define SWAPWORD(x)	MAKEWORD(HIBYTE(x), LOBYTE(x))
           49  +#define SWAPLONG(x)	MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
    45     50   
    46     51   /*
    47     52    * The following flag is used in OpenKeys to indicate that the specified key
    48     53    * should be created if it doesn't currently exist.
    49     54    */
    50     55   
    51     56   #define REG_CREATE 1
    52     57   
    53     58   /*
    54     59    * The following tables contain the mapping from registry root names to the
    55     60    * system predefined keys.
    56     61    */
    57     62   
    58         -static CONST char *rootKeyNames[] = {
           63  +static const char *const rootKeyNames[] = {
    59     64       "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT",
    60     65       "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG",
    61     66       "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL
    62     67   };
    63     68   
    64     69   static const HKEY rootKeys[] = {
    65     70       HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
    66     71       HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
    67     72   };
    68     73   
    69         -static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
           74  +static const char REGISTRY_ASSOC_KEY[] = "registry::command";
    70     75   
    71     76   /*
    72     77    * The following table maps from registry types to strings. Note that the
    73     78    * indices for this array are the same as the constants for the known registry
    74     79    * types so we don't need a separate table to hold the mapping.
    75     80    */
    76     81   
    77         -static CONST char *typeNames[] = {
           82  +static const char *const typeNames[] = {
    78     83       "none", "sz", "expand_sz", "binary", "dword",
    79     84       "dword_big_endian", "link", "multi_sz", "resource_list", NULL
    80     85   };
    81     86   
    82     87   static DWORD lastType = REG_RESOURCE_LIST;
    83         -
    84         -/*
    85         - * The following structures allow us to select between the Unicode and ASCII
    86         - * interfaces at run time based on whether Unicode APIs are available. The
    87         - * Unicode APIs are preferable because they will handle characters outside of
    88         - * the current code page.
    89         - */
    90         -
    91         -typedef struct RegWinProcs {
    92         -    int useWide;
    93         -
    94         -    LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
    95         -    LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
    96         -	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
    97         -    LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
    98         -    LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
    99         -    LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
   100         -    LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   101         -	    TCHAR *, DWORD *, FILETIME *);
   102         -    LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   103         -	    DWORD *, BYTE *, DWORD *);
   104         -    LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
   105         -	    HKEY *);
   106         -    LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
   107         -	    BYTE *, DWORD *);
   108         -    LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
   109         -	    CONST BYTE*, DWORD);
   110         -} RegWinProcs;
   111         -
   112         -static RegWinProcs *regWinProcs;
   113         -
   114         -static RegWinProcs asciiProcs = {
   115         -    0,
   116         -
   117         -    (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
   118         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
   119         -	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
   120         -	    DWORD *)) RegCreateKeyExA,
   121         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
   122         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
   123         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
   124         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   125         -	    TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA,
   126         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   127         -	    DWORD *, BYTE *, DWORD *)) RegEnumValueA,
   128         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
   129         -	    HKEY *)) RegOpenKeyExA,
   130         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
   131         -	    BYTE *, DWORD *)) RegQueryValueExA,
   132         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
   133         -	    CONST BYTE*, DWORD)) RegSetValueExA,
   134         -};
   135         -
   136         -static RegWinProcs unicodeProcs = {
   137         -    1,
   138         -
   139         -    (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
   140         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
   141         -	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
   142         -	    DWORD *)) RegCreateKeyExW,
   143         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
   144         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
   145         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
   146         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   147         -	    TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW,
   148         -    (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *,
   149         -	    DWORD *, BYTE *, DWORD *)) RegEnumValueW,
   150         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
   151         -	    HKEY *)) RegOpenKeyExW,
   152         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
   153         -	    BYTE *, DWORD *)) RegQueryValueExW,
   154         -    (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
   155         -	    CONST BYTE*, DWORD)) RegSetValueExW,
   156         -};
   157         -
   158     88   
   159     89   /*
   160     90    * Declarations for functions defined in this file.
   161     91    */
   162     92   
   163     93   static void		AppendSystemError(Tcl_Interp *interp, DWORD error);
   164     94   static int		BroadcastValue(Tcl_Interp *interp, int objc,
   165         -			    Tcl_Obj * CONST objv[]);
           95  +			    Tcl_Obj *const objv[]);
   166     96   static DWORD		ConvertDWORD(DWORD type, DWORD value);
   167     97   static void		DeleteCmd(ClientData clientData);
   168         -static int		DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
           98  +static int		DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
           99  +			    REGSAM mode);
   169    100   static int		DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   170         -			    Tcl_Obj *valueNameObj);
          101  +			    Tcl_Obj *valueNameObj, REGSAM mode);
   171    102   static int		GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   172         -			    Tcl_Obj *patternObj);
          103  +			    Tcl_Obj *patternObj, REGSAM mode);
   173    104   static int		GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   174         -			    Tcl_Obj *valueNameObj);
          105  +			    Tcl_Obj *valueNameObj, REGSAM mode);
   175    106   static int		GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   176         -			    Tcl_Obj *valueNameObj);
          107  +			    Tcl_Obj *valueNameObj, REGSAM mode);
   177    108   static int		GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   178         -			    Tcl_Obj *patternObj);
          109  +			    Tcl_Obj *patternObj, REGSAM mode);
   179    110   static int		OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   180    111   			    REGSAM mode, int flags, HKEY *keyPtr);
   181    112   static DWORD		OpenSubKey(char *hostName, HKEY rootKey,
   182    113   			    char *keyName, REGSAM mode, int flags,
   183    114   			    HKEY *keyPtr);
   184    115   static int		ParseKeyName(Tcl_Interp *interp, char *name,
   185    116   			    char **hostNamePtr, HKEY *rootKeyPtr,
   186    117   			    char **keyNamePtr);
   187    118   static DWORD		RecursiveDeleteKey(HKEY hStartKey,
   188         -			    CONST TCHAR * pKeyName);
          119  +			    const TCHAR * pKeyName, REGSAM mode);
   189    120   static int		RegistryObjCmd(ClientData clientData,
   190    121   			    Tcl_Interp *interp, int objc,
   191         -			    Tcl_Obj * CONST objv[]);
          122  +			    Tcl_Obj *const objv[]);
   192    123   static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
   193    124   			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
   194         -			    Tcl_Obj *typeObj);
          125  +			    Tcl_Obj *typeObj, REGSAM mode);
   195    126   
   196         -EXTERN int		Registry_Init(Tcl_Interp *interp);
   197         -EXTERN int		Registry_Unload(Tcl_Interp *interp, int flags);
          127  +DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
          128  +DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
   198    129   
   199    130   /*
   200    131    *----------------------------------------------------------------------
   201    132    *
   202    133    * Registry_Init --
   203    134    *
   204    135    *	This function initializes the registry command.
................................................................................
   214    145   
   215    146   int
   216    147   Registry_Init(
   217    148       Tcl_Interp *interp)
   218    149   {
   219    150       Tcl_Command cmd;
   220    151   
   221         -    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
          152  +    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
   222    153   	return TCL_ERROR;
   223    154       }
   224    155   
   225         -    /*
   226         -     * Determine if the unicode interfaces are available and select the
   227         -     * appropriate registry function table.
   228         -     */
   229         -
   230         -    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
   231         -	regWinProcs = &unicodeProcs;
   232         -    } else {
   233         -	regWinProcs = &asciiProcs;
   234         -    }
   235         -
   236    156       cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
   237         -	(ClientData)interp, DeleteCmd);
   238         -    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
   239         -    return Tcl_PkgProvide(interp, "registry", "1.2.2");
          157  +	    interp, DeleteCmd);
          158  +    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
          159  +    return Tcl_PkgProvide(interp, "registry", "1.3.3");
   240    160   }
   241    161   
   242    162   /*
   243    163    *----------------------------------------------------------------------
   244    164    *
   245    165    * Registry_Unload --
   246    166    *
................................................................................
   272    192       objv[2] = Tcl_NewStringObj("registry", -1);
   273    193       Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);
   274    194   
   275    195       /*
   276    196        * Delete the originally registered command.
   277    197        */
   278    198   
   279         -    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
          199  +    cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
   280    200       if (cmd != NULL) {
   281    201   	Tcl_DeleteCommandFromToken(interp, cmd);
   282    202       }
   283    203   
   284    204       return TCL_OK;
   285    205   }
   286    206   
................................................................................
   302    222    */
   303    223   
   304    224   static void
   305    225   DeleteCmd(
   306    226       ClientData clientData)
   307    227   {
   308    228       Tcl_Interp *interp = clientData;
   309         -    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
          229  +
          230  +    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL);
   310    231   }
   311    232   
   312    233   /*
   313    234    *----------------------------------------------------------------------
   314    235    *
   315    236    * RegistryObjCmd --
   316    237    *
................................................................................
   326    247    */
   327    248   
   328    249   static int
   329    250   RegistryObjCmd(
   330    251       ClientData clientData,	/* Not used. */
   331    252       Tcl_Interp *interp,		/* Current interpreter. */
   332    253       int objc,			/* Number of arguments. */
   333         -    Tcl_Obj * CONST objv[])	/* Argument values. */
          254  +    Tcl_Obj *const objv[])	/* Argument values. */
   334    255   {
   335         -    int index;
   336         -    char *errString = NULL;
          256  +    int n = 1;
          257  +    int index, argc;
          258  +    REGSAM mode = 0;
          259  +    const char *errString = NULL;
   337    260   
   338         -    static CONST char *subcommands[] = {
          261  +    static const char *const subcommands[] = {
   339    262   	"broadcast", "delete", "get", "keys", "set", "type", "values", NULL
   340    263       };
   341    264       enum SubCmdIdx {
   342    265   	BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
   343    266       };
          267  +    static const char *const modes[] = {
          268  +	"-32bit", "-64bit", NULL
          269  +    };
   344    270   
   345    271       if (objc < 2) {
   346         -	Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
          272  +    wrongArgs:
          273  +	Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?");
   347    274   	return TCL_ERROR;
   348    275       }
   349    276   
   350         -    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
   351         -	    != TCL_OK) {
          277  +    if (Tcl_GetString(objv[n])[0] == '-') {
          278  +	if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0,
          279  +		&index) != TCL_OK) {
          280  +	    return TCL_ERROR;
          281  +	}
          282  +	switch (index) {
          283  +	case 0:			/* -32bit */
          284  +	    mode |= KEY_WOW64_32KEY;
          285  +	    break;
          286  +	case 1:			/* -64bit */
          287  +	    mode |= KEY_WOW64_64KEY;
          288  +	    break;
          289  +	}
          290  +	if (objc < 3) {
          291  +	    goto wrongArgs;
          292  +	}
          293  +    }
          294  +
          295  +    if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0,
          296  +	    &index) != TCL_OK) {
   352    297   	return TCL_ERROR;
   353    298       }
   354    299   
          300  +    argc = (objc - n);
   355    301       switch (index) {
   356    302       case BroadcastIdx:		/* broadcast */
   357         -	return BroadcastValue(interp, objc, objv);
          303  +	if (argc == 1 || argc == 3) {
          304  +	    int res = BroadcastValue(interp, argc, objv + n);
          305  +
          306  +	    if (res != TCL_BREAK) {
          307  +		return res;
          308  +	    }
          309  +	}
          310  +	errString = "keyName ?-timeout milliseconds?";
   358    311   	break;
   359    312       case DeleteIdx:		/* delete */
   360         -	if (objc == 3) {
   361         -	    return DeleteKey(interp, objv[2]);
   362         -	} else if (objc == 4) {
   363         -	    return DeleteValue(interp, objv[2], objv[3]);
          313  +	if (argc == 1) {
          314  +	    return DeleteKey(interp, objv[n], mode);
          315  +	} else if (argc == 2) {
          316  +	    return DeleteValue(interp, objv[n], objv[n+1], mode);
   364    317   	}
   365    318   	errString = "keyName ?valueName?";
   366    319   	break;
   367    320       case GetIdx:		/* get */
   368         -	if (objc == 4) {
   369         -	    return GetValue(interp, objv[2], objv[3]);
          321  +	if (argc == 2) {
          322  +	    return GetValue(interp, objv[n], objv[n+1], mode);
   370    323   	}
   371    324   	errString = "keyName valueName";
   372    325   	break;
   373    326       case KeysIdx:		/* keys */
   374         -	if (objc == 3) {
   375         -	    return GetKeyNames(interp, objv[2], NULL);
   376         -	} else if (objc == 4) {
   377         -	    return GetKeyNames(interp, objv[2], objv[3]);
          327  +	if (argc == 1) {
          328  +	    return GetKeyNames(interp, objv[n], NULL, mode);
          329  +	} else if (argc == 2) {
          330  +	    return GetKeyNames(interp, objv[n], objv[n+1], mode);
   378    331   	}
   379    332   	errString = "keyName ?pattern?";
   380    333   	break;
   381    334       case SetIdx:		/* set */
   382         -	if (objc == 3) {
          335  +	if (argc == 1) {
   383    336   	    HKEY key;
   384    337   
   385    338   	    /*
   386    339   	     * Create the key and then close it immediately.
   387    340   	     */
   388    341   
   389         -	    if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
          342  +	    mode |= KEY_ALL_ACCESS;
          343  +	    if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) {
   390    344   		return TCL_ERROR;
   391    345   	    }
   392    346   	    RegCloseKey(key);
   393    347   	    return TCL_OK;
   394         -	} else if (objc == 5 || objc == 6) {
   395         -	    Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
   396         -	    return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
          348  +	} else if (argc == 3) {
          349  +	    return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL,
          350  +		    mode);
          351  +	} else if (argc == 4) {
          352  +	    return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3],
          353  +		    mode);
   397    354   	}
   398    355   	errString = "keyName ?valueName data ?type??";
   399    356   	break;
   400    357       case TypeIdx:		/* type */
   401         -	if (objc == 4) {
   402         -	    return GetType(interp, objv[2], objv[3]);
          358  +	if (argc == 2) {
          359  +	    return GetType(interp, objv[n], objv[n+1], mode);
   403    360   	}
   404    361   	errString = "keyName valueName";
   405    362   	break;
   406    363       case ValuesIdx:		/* values */
   407         -	if (objc == 3) {
   408         -	    return GetValueNames(interp, objv[2], NULL);
   409         -	} else if (objc == 4) {
   410         -	    return GetValueNames(interp, objv[2], objv[3]);
          364  +	if (argc == 1) {
          365  +	    return GetValueNames(interp, objv[n], NULL, mode);
          366  +	} else if (argc == 2) {
          367  +	    return GetValueNames(interp, objv[n], objv[n+1], mode);
   411    368   	}
   412    369   	errString = "keyName ?pattern?";
   413    370   	break;
   414    371       }
   415         -    Tcl_WrongNumArgs(interp, 2, objv, errString);
          372  +    Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString);
   416    373       return TCL_ERROR;
   417    374   }
   418    375   
   419    376   /*
   420    377    *----------------------------------------------------------------------
   421    378    *
   422    379    * DeleteKey --
................................................................................
   431    388    *
   432    389    *----------------------------------------------------------------------
   433    390    */
   434    391   
   435    392   static int
   436    393   DeleteKey(
   437    394       Tcl_Interp *interp,		/* Current interpreter. */
   438         -    Tcl_Obj *keyNameObj)	/* Name of key to delete. */
          395  +    Tcl_Obj *keyNameObj,	/* Name of key to delete. */
          396  +    REGSAM mode)		/* Mode flags to pass. */
   439    397   {
   440    398       char *tail, *buffer, *hostName, *keyName;
   441         -    CONST char *nativeTail;
          399  +    const TCHAR *nativeTail;
   442    400       HKEY rootKey, subkey;
   443    401       DWORD result;
   444         -    int length;
   445    402       Tcl_DString buf;
          403  +    REGSAM saveMode = mode;
   446    404   
   447    405       /*
   448    406        * Find the parent of the key being deleted and open it.
   449    407        */
   450    408   
   451         -    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
   452         -    buffer = ckalloc((unsigned int) length + 1);
          409  +    keyName = Tcl_GetString(keyNameObj);
          410  +    buffer = Tcl_Alloc(keyNameObj->length + 1);
   453    411       strcpy(buffer, keyName);
   454    412   
   455    413       if (ParseKeyName(interp, buffer, &hostName, &rootKey,
   456    414   	    &keyName) != TCL_OK) {
   457         -	ckfree(buffer);
          415  +	Tcl_Free(buffer);
   458    416   	return TCL_ERROR;
   459    417       }
   460    418   
   461    419       if (*keyName == '\0') {
   462         -	Tcl_SetObjResult(interp, Tcl_NewStringObj(
   463         -		"bad key: cannot delete root keys", -1));
   464         -	ckfree(buffer);
          420  +	Tcl_SetObjResult(interp,
          421  +		Tcl_NewStringObj("bad key: cannot delete root keys", -1));
          422  +	Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
          423  +	Tcl_Free(buffer);
   465    424   	return TCL_ERROR;
   466    425       }
   467    426   
   468    427       tail = strrchr(keyName, '\\');
   469    428       if (tail) {
   470    429   	*tail++ = '\0';
   471    430       } else {
   472    431   	tail = keyName;
   473    432   	keyName = NULL;
   474    433       }
   475    434   
   476         -    result = OpenSubKey(hostName, rootKey, keyName,
   477         -	    KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey);
          435  +    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
          436  +    result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
   478    437       if (result != ERROR_SUCCESS) {
   479         -	ckfree(buffer);
          438  +	Tcl_Free(buffer);
   480    439   	if (result == ERROR_FILE_NOT_FOUND) {
   481    440   	    return TCL_OK;
   482    441   	}
   483         -	Tcl_SetObjResult(interp, Tcl_NewStringObj(
   484         -		"unable to delete key: ", -1));
          442  +	Tcl_SetObjResult(interp,
          443  +		Tcl_NewStringObj("unable to delete key: ", -1));
   485    444   	AppendSystemError(interp, result);
   486    445   	return TCL_ERROR;
   487    446       }
   488    447   
   489    448       /*
   490    449        * Now we recursively delete the key and everything below it.
   491    450        */
   492    451   
   493    452       nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf);
   494         -    result = RecursiveDeleteKey(subkey, nativeTail);
          453  +    result = RecursiveDeleteKey(subkey, nativeTail, saveMode);
   495    454       Tcl_DStringFree(&buf);
   496    455   
   497    456       if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
   498    457   	Tcl_SetObjResult(interp,
   499    458   		Tcl_NewStringObj("unable to delete key: ", -1));
   500    459   	AppendSystemError(interp, result);
   501    460   	result = TCL_ERROR;
   502    461       } else {
   503    462   	result = TCL_OK;
   504    463       }
   505    464   
   506    465       RegCloseKey(subkey);
   507         -    ckfree(buffer);
          466  +    Tcl_Free(buffer);
   508    467       return result;
   509    468   }
   510    469   
   511    470   /*
   512    471    *----------------------------------------------------------------------
   513    472    *
   514    473    * DeleteValue --
................................................................................
   524    483    *----------------------------------------------------------------------
   525    484    */
   526    485   
   527    486   static int
   528    487   DeleteValue(
   529    488       Tcl_Interp *interp,		/* Current interpreter. */
   530    489       Tcl_Obj *keyNameObj,	/* Name of key. */
   531         -    Tcl_Obj *valueNameObj)	/* Name of value to delete. */
          490  +    Tcl_Obj *valueNameObj,	/* Name of value to delete. */
          491  +    REGSAM mode)		/* Mode flags to pass. */
   532    492   {
   533    493       HKEY key;
   534    494       char *valueName;
   535         -    int length;
          495  +    size_t length;
   536    496       DWORD result;
   537    497       Tcl_DString ds;
   538    498   
   539    499       /*
   540    500        * Attempt to open the key for deletion.
   541    501        */
   542    502   
   543         -    if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key)
   544         -	    != TCL_OK) {
          503  +    mode |= KEY_SET_VALUE;
          504  +    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
   545    505   	return TCL_ERROR;
   546    506       }
   547    507   
   548         -    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
          508  +    valueName = Tcl_GetString(valueNameObj);
          509  +    length = valueNameObj->length;
   549    510       Tcl_WinUtfToTChar(valueName, length, &ds);
   550         -    result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
          511  +    result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
   551    512       Tcl_DStringFree(&ds);
   552    513       if (result != ERROR_SUCCESS) {
   553         -	Tcl_AppendResult(interp, "unable to delete value \"",
   554         -		Tcl_GetString(valueNameObj), "\" from key \"",
   555         -		Tcl_GetString(keyNameObj), "\": ", NULL);
          514  +	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          515  +		"unable to delete value \"%s\" from key \"%s\": ",
          516  +		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
   556    517   	AppendSystemError(interp, result);
   557    518   	result = TCL_ERROR;
   558    519       } else {
   559    520   	result = TCL_OK;
   560    521       }
   561    522       RegCloseKey(key);
   562    523       return result;
................................................................................
   581    542    *----------------------------------------------------------------------
   582    543    */
   583    544   
   584    545   static int
   585    546   GetKeyNames(
   586    547       Tcl_Interp *interp,		/* Current interpreter. */
   587    548       Tcl_Obj *keyNameObj,	/* Key to enumerate. */
   588         -    Tcl_Obj *patternObj)	/* Optional match pattern. */
          549  +    Tcl_Obj *patternObj,	/* Optional match pattern. */
          550  +    REGSAM mode)		/* Mode flags to pass. */
   589    551   {
   590         -    char *pattern;		/* Pattern being matched against subkeys */
          552  +    const char *pattern;	/* Pattern being matched against subkeys */
   591    553       HKEY key;			/* Handle to the key being examined */
   592         -    TCHAR buffer[MAX_KEY_LENGTH*2];		/* Buffer to hold the subkey name */
          554  +    TCHAR buffer[MAX_KEY_LENGTH];
          555  +				/* Buffer to hold the subkey name */
   593    556       DWORD bufSize;		/* Size of the buffer */
   594    557       DWORD index;		/* Position of the current subkey */
   595    558       char *name;			/* Subkey name */
   596    559       Tcl_Obj *resultPtr;		/* List of subkeys being accumulated */
   597    560       int result = TCL_OK;	/* Return value from this command */
   598    561       Tcl_DString ds;		/* Buffer to translate subkey name to UTF-8 */
   599    562   
   600    563       if (patternObj) {
   601    564   	pattern = Tcl_GetString(patternObj);
   602    565       } else {
   603    566   	pattern = NULL;
   604    567       }
   605    568   
   606         -    /* Attempt to open the key for enumeration. */
          569  +    /*
          570  +     * Attempt to open the key for enumeration.
          571  +     */
   607    572   
   608         -    if (OpenKey(interp, keyNameObj,
   609         -		KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS,
   610         -		0, &key) != TCL_OK) {
          573  +    mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
          574  +    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
   611    575   	return TCL_ERROR;
   612    576       }
   613    577   
   614         -    /* Enumerate the subkeys */
          578  +    /*
          579  +     * Enumerate the subkeys.
          580  +     */
   615    581   
   616    582       resultPtr = Tcl_NewObj();
   617    583       for (index = 0;; ++index) {
   618    584   	bufSize = MAX_KEY_LENGTH;
   619         -	result = (*regWinProcs->regEnumKeyExProc)
   620         -	    (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
          585  +	result = RegEnumKeyEx(key, index, buffer, &bufSize,
          586  +		NULL, NULL, NULL, NULL);
   621    587   	if (result != ERROR_SUCCESS) {
   622    588   	    if (result == ERROR_NO_MORE_ITEMS) {
   623    589   		result = TCL_OK;
   624    590   	    } else {
   625         -		Tcl_SetObjResult(interp, Tcl_NewObj());
   626         -		Tcl_AppendResult(interp,
   627         -			"unable to enumerate subkeys of \"",
   628         -			Tcl_GetString(keyNameObj), "\": ", NULL);
          591  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          592  +			"unable to enumerate subkeys of \"%s\": ",
          593  +			Tcl_GetString(keyNameObj)));
   629    594   		AppendSystemError(interp, result);
   630    595   		result = TCL_ERROR;
   631    596   	    }
   632    597   	    break;
   633    598   	}
   634         -	if (regWinProcs->useWide) {
   635         -	    Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds);
   636         -	} else {
   637         -	    Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds);
   638         -	}
   639         -	name = Tcl_DStringValue(&ds);
          599  +	name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
   640    600   	if (pattern && !Tcl_StringMatch(name, pattern)) {
   641    601   	    Tcl_DStringFree(&ds);
   642    602   	    continue;
   643    603   	}
   644    604   	result = Tcl_ListObjAppendElement(interp, resultPtr,
   645    605   		Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
   646    606   	Tcl_DStringFree(&ds);
................................................................................
   675    635    *----------------------------------------------------------------------
   676    636    */
   677    637   
   678    638   static int
   679    639   GetType(
   680    640       Tcl_Interp *interp,		/* Current interpreter. */
   681    641       Tcl_Obj *keyNameObj,	/* Name of key. */
   682         -    Tcl_Obj *valueNameObj)	/* Name of value to get. */
          642  +    Tcl_Obj *valueNameObj,	/* Name of value to get. */
          643  +    REGSAM mode)		/* Mode flags to pass. */
   683    644   {
   684    645       HKEY key;
   685         -    DWORD result;
   686         -    DWORD type;
          646  +    DWORD result, type;
   687    647       Tcl_DString ds;
   688         -    char *valueName;
   689         -    CONST char *nativeValue;
   690         -    int length;
          648  +    const char *valueName;
          649  +    const TCHAR *nativeValue;
          650  +    size_t length;
   691    651   
   692    652       /*
   693    653        * Attempt to open the key for reading.
   694    654        */
   695    655   
   696         -    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
   697         -	    != TCL_OK) {
          656  +    mode |= KEY_QUERY_VALUE;
          657  +    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
   698    658   	return TCL_ERROR;
   699    659       }
   700    660   
   701    661       /*
   702    662        * Get the type of the value.
   703    663        */
   704    664   
   705         -    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
          665  +    valueName = Tcl_GetString(valueNameObj);
          666  +    length = valueNameObj->length;
   706    667       nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
   707         -    result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
          668  +    result = RegQueryValueEx(key, nativeValue, NULL, &type,
   708    669   	    NULL, NULL);
   709    670       Tcl_DStringFree(&ds);
   710    671       RegCloseKey(key);
   711    672   
   712    673       if (result != ERROR_SUCCESS) {
   713         -	Tcl_AppendResult(interp, "unable to get type of value \"",
   714         -		Tcl_GetString(valueNameObj), "\" from key \"",
   715         -		Tcl_GetString(keyNameObj), "\": ", NULL);
          674  +	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          675  +		"unable to get type of value \"%s\" from key \"%s\": ",
          676  +		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
   716    677   	AppendSystemError(interp, result);
   717    678   	return TCL_ERROR;
   718    679       }
   719    680   
   720    681       /*
   721    682        * Set the type into the result. Watch out for unknown types. If we don't
   722    683        * know about the type, just use the numeric value.
................................................................................
   747    708    *----------------------------------------------------------------------
   748    709    */
   749    710   
   750    711   static int
   751    712   GetValue(
   752    713       Tcl_Interp *interp,		/* Current interpreter. */
   753    714       Tcl_Obj *keyNameObj,	/* Name of key. */
   754         -    Tcl_Obj *valueNameObj)	/* Name of value to get. */
          715  +    Tcl_Obj *valueNameObj,	/* Name of value to get. */
          716  +    REGSAM mode)		/* Mode flags to pass. */
   755    717   {
   756    718       HKEY key;
   757         -    char *valueName;
   758         -    CONST char *nativeValue;
          719  +    const char *valueName;
          720  +    const TCHAR *nativeValue;
   759    721       DWORD result, length, type;
   760    722       Tcl_DString data, buf;
   761         -    int nameLen;
          723  +    size_t nameLen;
   762    724   
   763    725       /*
   764    726        * Attempt to open the key for reading.
   765    727        */
   766    728   
   767         -    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
          729  +    mode |= KEY_QUERY_VALUE;
          730  +    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
   768    731   	return TCL_ERROR;
   769    732       }
   770    733   
   771    734       /*
   772    735        * Initialize a Dstring to maximum statically allocated size we could get
   773    736        * one more byte by avoiding Tcl_DStringSetLength() and just setting
   774    737        * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the
................................................................................
   776    739        *
   777    740        * This allows short values to be read from the registy in one call.
   778    741        * Longer values need a second call with an expanded DString.
   779    742        */
   780    743   
   781    744       Tcl_DStringInit(&data);
   782    745       Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
   783         -    length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1;
          746  +    length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
   784    747   
   785         -    valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
          748  +    valueName = Tcl_GetString(valueNameObj);
          749  +    nameLen = valueNameObj->length;
   786    750       nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
   787    751   
   788         -    result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
          752  +    result = RegQueryValueEx(key, nativeValue, NULL, &type,
   789    753   	    (BYTE *) Tcl_DStringValue(&data), &length);
   790    754       while (result == ERROR_MORE_DATA) {
   791    755   	/*
   792    756   	 * The Windows docs say that in this error case, we just need to
   793    757   	 * expand our buffer and request more data. Required for
   794    758   	 * HKEY_PERFORMANCE_DATA
   795    759   	 */
   796    760   
   797         -	length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2);
   798         -	Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1));
   799         -	result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
          761  +	length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR));
          762  +	Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR));
          763  +	result = RegQueryValueEx(key, nativeValue,
   800    764   		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
   801    765       }
   802    766       Tcl_DStringFree(&buf);
   803    767       RegCloseKey(key);
   804    768       if (result != ERROR_SUCCESS) {
   805         -	Tcl_AppendResult(interp, "unable to get value \"",
   806         -		Tcl_GetString(valueNameObj), "\" from key \"",
   807         -		Tcl_GetString(keyNameObj), "\": ", NULL);
          769  +	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
          770  +		"unable to get value \"%s\" from key \"%s\": ",
          771  +		Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
   808    772   	AppendSystemError(interp, result);
   809    773   	Tcl_DStringFree(&data);
   810    774   	return TCL_ERROR;
   811    775       }
   812    776   
   813    777       /*
   814    778        * If the data is a 32-bit quantity, store it as an integer object. If it
................................................................................
   815    779        * is a multi-string, store it as a list of strings. For null-terminated
   816    780        * strings, append up the to first null. Otherwise, store it as a binary
   817    781        * string.
   818    782        */
   819    783   
   820    784       if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
   821    785   	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type,
   822         -		*((DWORD*) Tcl_DStringValue(&data)))));
          786  +		*((DWORD *) Tcl_DStringValue(&data)))));
   823    787       } else if (type == REG_MULTI_SZ) {
   824    788   	char *p = Tcl_DStringValue(&data);
   825    789   	char *end = Tcl_DStringValue(&data) + length;
   826    790   	Tcl_Obj *resultPtr = Tcl_NewObj();
   827    791   
   828    792   	/*
   829    793   	 * Multistrings are stored as an array of null-terminated strings,
   830    794   	 * terminated by two null characters. Also do a bounds check in case
   831    795   	 * we get bogus data.
   832    796   	 */
   833    797   
   834         -	while (p < end 	&& ((regWinProcs->useWide)
   835         -		? *((Tcl_UniChar *)p) : *p) != 0) {
          798  +	while ((p < end) && *((WCHAR *) p) != 0) {
          799  +	    WCHAR *wp;
          800  +
   836    801   	    Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
   837    802   	    Tcl_ListObjAppendElement(interp, resultPtr,
   838    803   		    Tcl_NewStringObj(Tcl_DStringValue(&buf),
   839    804   			    Tcl_DStringLength(&buf)));
   840         -	    if (regWinProcs->useWide) {
   841         -		Tcl_UniChar* up = (Tcl_UniChar*) p;
   842         -		while (*up++ != 0) {}
   843         -		p = (char*) up;
   844         -	    } else {
   845         -		while (*p++ != '\0') {}
   846         -	    }
          805  +	    wp = (WCHAR *) p;
          806  +
          807  +	    while (*wp++ != 0) {/* empty body */}
          808  +	    p = (char *) wp;
   847    809   	    Tcl_DStringFree(&buf);
   848    810   	}
   849    811   	Tcl_SetObjResult(interp, resultPtr);
   850    812       } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
   851    813   	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
   852    814   	Tcl_DStringResult(interp, &buf);
   853    815       } else {
................................................................................
   881    843    *----------------------------------------------------------------------
   882    844    */
   883    845   
   884    846   static int
   885    847   GetValueNames(
   886    848       Tcl_Interp *interp,		/* Current interpreter. */
   887    849       Tcl_Obj *keyNameObj,	/* Key to enumerate. */
   888         -    Tcl_Obj *patternObj)	/* Optional match pattern. */
          850  +    Tcl_Obj *patternObj,	/* Optional match pattern. */
          851  +    REGSAM mode)		/* Mode flags to pass. */
   889    852   {
   890    853       HKEY key;
   891    854       Tcl_Obj *resultPtr;
   892    855       DWORD index, size, result;
   893    856       Tcl_DString buffer, ds;
   894         -    char *pattern, *name;
          857  +    const char *pattern, *name;
   895    858   
   896    859       /*
   897    860        * Attempt to open the key for enumeration.
   898    861        */
   899    862   
   900         -    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
   901         -	    != TCL_OK) {
          863  +    mode |= KEY_QUERY_VALUE;
          864  +    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
   902    865   	return TCL_ERROR;
   903    866       }
   904    867   
   905    868       resultPtr = Tcl_NewObj();
   906    869       Tcl_DStringInit(&buffer);
   907         -    Tcl_DStringSetLength(&buffer,
   908         -	    (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH));
          870  +    Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
   909    871       index = 0;
   910    872       result = TCL_OK;
   911    873   
   912    874       if (patternObj) {
   913    875   	pattern = Tcl_GetString(patternObj);
   914    876       } else {
   915    877   	pattern = NULL;
................................................................................
   918    880       /*
   919    881        * Enumerate the values under the given subkey until we get an error,
   920    882        * indicating the end of the list. Note that we need to reset size after
   921    883        * each iteration because RegEnumValue smashes the old value.
   922    884        */
   923    885   
   924    886       size = MAX_KEY_LENGTH;
   925         -    while ((*regWinProcs->regEnumValueProc)(key, index,
   926         -	    Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
   927         -	    == ERROR_SUCCESS) {
   928         -
   929         -	if (regWinProcs->useWide) {
   930         -	    size *= 2;
   931         -	}
          887  +    while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
          888  +	    &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
          889  +	size *= sizeof(TCHAR);
   932    890   
   933    891   	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
   934    892   		&ds);
   935    893   	name = Tcl_DStringValue(&ds);
   936    894   	if (!pattern || Tcl_StringMatch(name, pattern)) {
   937    895   	    result = Tcl_ListObjAppendElement(interp, resultPtr,
   938    896   		    Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
................................................................................
   974    932       Tcl_Interp *interp,		/* Current interpreter. */
   975    933       Tcl_Obj *keyNameObj,	/* Key to open. */
   976    934       REGSAM mode,		/* Access mode. */
   977    935       int flags,			/* 0 or REG_CREATE. */
   978    936       HKEY *keyPtr)		/* Returned HKEY. */
   979    937   {
   980    938       char *keyName, *buffer, *hostName;
   981         -    int length;
          939  +    size_t length;
   982    940       HKEY rootKey;
   983    941       DWORD result;
   984    942   
   985         -    keyName = Tcl_GetStringFromObj(keyNameObj, &length);
   986         -    buffer = ckalloc((unsigned int) length + 1);
          943  +    keyName = Tcl_GetString(keyNameObj);
          944  +    length = keyNameObj->length;
          945  +    buffer = Tcl_Alloc(length + 1);
   987    946       strcpy(buffer, keyName);
   988    947   
   989    948       result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
   990    949       if (result == TCL_OK) {
   991    950   	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
   992    951   	if (result != ERROR_SUCCESS) {
   993    952   	    Tcl_SetObjResult(interp,
................................................................................
   995    954   	    AppendSystemError(interp, result);
   996    955   	    result = TCL_ERROR;
   997    956   	} else {
   998    957   	    result = TCL_OK;
   999    958   	}
  1000    959       }
  1001    960   
  1002         -    ckfree(buffer);
          961  +    Tcl_Free(buffer);
  1003    962       return result;
  1004    963   }
  1005    964   
  1006    965   /*
  1007    966    *----------------------------------------------------------------------
  1008    967    *
  1009    968    * OpenSubKey --
................................................................................
  1035    994   
  1036    995       /*
  1037    996        * Attempt to open the root key on a remote host if necessary.
  1038    997        */
  1039    998   
  1040    999       if (hostName) {
  1041   1000   	hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf);
  1042         -	result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey,
         1001  +	result = RegConnectRegistry((TCHAR *)hostName, rootKey,
  1043   1002   		&rootKey);
  1044   1003   	Tcl_DStringFree(&buf);
  1045   1004   	if (result != ERROR_SUCCESS) {
  1046   1005   	    return result;
  1047   1006   	}
  1048   1007       }
  1049   1008   
  1050   1009       /*
  1051   1010        * Now open the specified key with the requested permissions. Note that
  1052   1011        * this key must be closed by the caller.
  1053   1012        */
  1054   1013   
  1055         -    keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
         1014  +    if (keyName) {
         1015  +	keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
         1016  +    }
  1056   1017       if (flags & REG_CREATE) {
  1057   1018   	DWORD create;
  1058         -	result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
         1019  +
         1020  +	result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL,
  1059   1021   		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
  1060   1022       } else if (rootKey == HKEY_PERFORMANCE_DATA) {
  1061   1023   	/*
  1062   1024   	 * Here we fudge it for this special root key. See MSDN for more info
  1063   1025   	 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
  1064   1026   	 */
         1027  +
  1065   1028   	*keyPtr = HKEY_PERFORMANCE_DATA;
  1066   1029   	result = ERROR_SUCCESS;
  1067   1030       } else {
  1068         -	result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
         1031  +	result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
  1069   1032   		keyPtr);
  1070   1033       }
  1071         -    Tcl_DStringFree(&buf);
         1034  +    if (keyName) {
         1035  +	Tcl_DStringFree(&buf);
         1036  +    }
  1072   1037   
  1073   1038       /*
  1074   1039        * Be sure to close the root key since we are done with it now.
  1075   1040        */
  1076   1041   
  1077   1042       if (hostName) {
  1078   1043   	RegCloseKey(rootKey);
................................................................................
  1125   1090   		}
  1126   1091   	    }
  1127   1092   	}
  1128   1093       } else {
  1129   1094   	rootName = name;
  1130   1095       }
  1131   1096       if (!rootName) {
  1132         -	Tcl_AppendResult(interp, "bad key \"", name,
  1133         -		"\": must start with a valid root", NULL);
         1097  +	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         1098  +		"bad key \"%s\": must start with a valid root", name));
         1099  +	Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL);
  1134   1100   	return TCL_ERROR;
  1135   1101       }
  1136   1102   
  1137   1103       /*
  1138   1104        * Split the root into root and subkey portions.
  1139   1105        */
  1140   1106   
................................................................................
  1178   1144    *
  1179   1145    *----------------------------------------------------------------------
  1180   1146    */
  1181   1147   
  1182   1148   static DWORD
  1183   1149   RecursiveDeleteKey(
  1184   1150       HKEY startKey,		/* Parent of key to be deleted. */
  1185         -    CONST char *keyName)	/* Name of key to be deleted in external
         1151  +    const TCHAR *keyName,	/* Name of key to be deleted in external
  1186   1152   				 * encoding, not UTF. */
         1153  +    REGSAM mode)		/* Mode flags to pass. */
  1187   1154   {
  1188   1155       DWORD result, size;
  1189   1156       Tcl_DString subkey;
  1190   1157       HKEY hKey;
         1158  +    REGSAM saveMode = mode;
         1159  +    static int checkExProc = 0;
         1160  +    static FARPROC regDeleteKeyExProc = NULL;
  1191   1161   
  1192   1162       /*
  1193   1163        * Do not allow NULL or empty key name.
  1194   1164        */
  1195   1165   
  1196   1166       if (!keyName || *keyName == '\0') {
  1197   1167   	return ERROR_BADKEY;
  1198   1168       }
  1199   1169   
  1200         -    result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0,
  1201         -	    KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey);
         1170  +    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
         1171  +    result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
  1202   1172       if (result != ERROR_SUCCESS) {
  1203   1173   	return result;
  1204   1174       }
  1205   1175   
  1206   1176       Tcl_DStringInit(&subkey);
  1207         -    Tcl_DStringSetLength(&subkey,
  1208         -	    (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH));
         1177  +    Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR)));
  1209   1178   
         1179  +    mode = saveMode;
  1210   1180       while (result == ERROR_SUCCESS) {
  1211   1181   	/*
  1212   1182   	 * Always get index 0 because key deletion changes ordering.
  1213   1183   	 */
  1214   1184   
  1215   1185   	size = MAX_KEY_LENGTH;
  1216         -	result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
  1217         -		Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
         1186  +	result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
         1187  +		&size, NULL, NULL, NULL, NULL);
  1218   1188   	if (result == ERROR_NO_MORE_ITEMS) {
  1219         -	    result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName);
         1189  +	    /*
         1190  +	     * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
         1191  +	     * can't compile with it in. We need to check for it at runtime
         1192  +	     * and use it if we find it.
         1193  +	     */
         1194  +
         1195  +	    if (mode && !checkExProc) {
         1196  +		HMODULE handle;
         1197  +
         1198  +		checkExProc = 1;
         1199  +		handle = GetModuleHandle(TEXT("ADVAPI32"));
         1200  +		regDeleteKeyExProc = (FARPROC)
         1201  +			GetProcAddress(handle, "RegDeleteKeyExW");
         1202  +	    }
         1203  +	    if (mode && regDeleteKeyExProc) {
         1204  +		result = regDeleteKeyExProc(startKey, keyName, mode, 0);
         1205  +	    } else {
         1206  +		result = RegDeleteKey(startKey, keyName);
         1207  +	    }
  1220   1208   	    break;
  1221   1209   	} else if (result == ERROR_SUCCESS) {
  1222         -	    result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey));
         1210  +	    result = RecursiveDeleteKey(hKey,
         1211  +		    (const TCHAR *) Tcl_DStringValue(&subkey), mode);
  1223   1212   	}
  1224   1213       }
  1225   1214       Tcl_DStringFree(&subkey);
  1226   1215       RegCloseKey(hKey);
  1227   1216       return result;
  1228   1217   }
  1229   1218   
................................................................................
  1247   1236   
  1248   1237   static int
  1249   1238   SetValue(
  1250   1239       Tcl_Interp *interp,		/* Current interpreter. */
  1251   1240       Tcl_Obj *keyNameObj,	/* Name of key. */
  1252   1241       Tcl_Obj *valueNameObj,	/* Name of value to set. */
  1253   1242       Tcl_Obj *dataObj,		/* Data to be written. */
  1254         -    Tcl_Obj *typeObj)		/* Type of data to be written. */
         1243  +    Tcl_Obj *typeObj,		/* Type of data to be written. */
         1244  +    REGSAM mode)		/* Mode flags to pass. */
  1255   1245   {
  1256   1246       int type;
         1247  +    size_t length;
  1257   1248       DWORD result;
  1258   1249       HKEY key;
  1259         -    int length;
  1260         -    char *valueName;
         1250  +    const char *valueName;
  1261   1251       Tcl_DString nameBuf;
  1262   1252   
  1263   1253       if (typeObj == NULL) {
  1264   1254   	type = REG_SZ;
  1265   1255       } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
  1266   1256   	    0, (int *) &type) != TCL_OK) {
  1267         -	if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
         1257  +	if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
  1268   1258   	    return TCL_ERROR;
  1269   1259   	}
  1270   1260   	Tcl_ResetResult(interp);
  1271   1261       }
  1272         -    if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
         1262  +    mode |= KEY_ALL_ACCESS;
         1263  +    if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) {
  1273   1264   	return TCL_ERROR;
  1274   1265       }
  1275   1266   
  1276         -    valueName = Tcl_GetStringFromObj(valueNameObj, &length);
         1267  +    valueName = Tcl_GetString(valueNameObj);
         1268  +    length = valueNameObj->length;
  1277   1269       valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
  1278   1270   
  1279   1271       if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
  1280   1272   	int value;
  1281   1273   
  1282   1274   	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
  1283   1275   	    RegCloseKey(key);
  1284   1276   	    Tcl_DStringFree(&nameBuf);
  1285   1277   	    return TCL_ERROR;
  1286   1278   	}
  1287   1279   
  1288         -	value = ConvertDWORD((DWORD)type, (DWORD)value);
  1289         -	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
         1280  +	value = ConvertDWORD((DWORD) type, (DWORD) value);
         1281  +	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
  1290   1282   		(DWORD) type, (BYTE *) &value, sizeof(DWORD));
  1291   1283       } else if (type == REG_MULTI_SZ) {
  1292   1284   	Tcl_DString data, buf;
  1293   1285   	int objc, i;
  1294   1286   	Tcl_Obj **objv;
  1295   1287   
  1296   1288   	if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) {
................................................................................
  1303   1295   	 * Append the elements as null terminated strings. Note that we must
  1304   1296   	 * not assume the length of the string in case there are embedded
  1305   1297   	 * nulls, which aren't allowed in REG_MULTI_SZ values.
  1306   1298   	 */
  1307   1299   
  1308   1300   	Tcl_DStringInit(&data);
  1309   1301   	for (i = 0; i < objc; i++) {
  1310         -	    Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
         1302  +	    const char *bytes = Tcl_GetString(objv[i]);
         1303  +
         1304  +	    length = objv[i]->length;
         1305  +	    Tcl_DStringAppend(&data, bytes, length);
  1311   1306   
  1312   1307   	    /*
  1313         -	     * Add a null character to separate this value from the next. We
  1314         -	     * accomplish this by growing the string by one byte. Since the
  1315         -	     * DString always tacks on an extra null byte, the new byte will
  1316         -	     * already be set to null.
         1308  +	     * Add a null character to separate this value from the next.
  1317   1309   	     */
  1318   1310   
  1319         -	    Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1);
         1311  +	    Tcl_DStringAppend(&data, "", 1);	/* NUL-terminated string */
  1320   1312   	}
  1321   1313   
  1322   1314   	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
  1323   1315   		&buf);
  1324         -	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
  1325         -                (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
         1316  +	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
         1317  +		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
  1326   1318   		(DWORD) Tcl_DStringLength(&buf));
  1327   1319   	Tcl_DStringFree(&data);
  1328   1320   	Tcl_DStringFree(&buf);
  1329   1321       } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
  1330   1322   	Tcl_DString buf;
  1331         -	CONST char *data = Tcl_GetStringFromObj(dataObj, &length);
         1323  +	const char *data = Tcl_GetString(dataObj);
  1332   1324   
  1333         -	data = Tcl_WinUtfToTChar(data, length, &buf);
         1325  +	length = dataObj->length;
         1326  +	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
  1334   1327   
  1335   1328   	/*
  1336         -	 * Include the null in the length, padding if needed for Unicode.
         1329  +	 * Include the null in the length, padding if needed for WCHAR.
  1337   1330   	 */
  1338   1331   
  1339         -	if (regWinProcs->useWide) {
  1340         -	    Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
  1341         -	}
         1332  +	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
  1342   1333   	length = Tcl_DStringLength(&buf) + 1;
  1343   1334   
  1344         -	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
  1345         -                (DWORD) type, (BYTE *) data, (DWORD) length);
         1335  +	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
         1336  +		(DWORD) type, (BYTE *) data, (DWORD) length);
  1346   1337   	Tcl_DStringFree(&buf);
  1347   1338       } else {
  1348   1339   	BYTE *data;
         1340  +	int bytelength;
  1349   1341   
  1350   1342   	/*
  1351   1343   	 * Store binary data in the registry.
  1352   1344   	 */
  1353   1345   
  1354         -	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
  1355         -	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
  1356         -                (DWORD) type, data, (DWORD) length);
         1346  +	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
         1347  +	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
         1348  +		(DWORD) type, data, (DWORD) bytelength);
  1357   1349       }
  1358   1350   
  1359   1351       Tcl_DStringFree(&nameBuf);
  1360   1352       RegCloseKey(key);
  1361   1353   
  1362   1354       if (result != ERROR_SUCCESS) {
  1363   1355   	Tcl_SetObjResult(interp,
................................................................................
  1385   1377    *----------------------------------------------------------------------
  1386   1378    */
  1387   1379   
  1388   1380   static int
  1389   1381   BroadcastValue(
  1390   1382       Tcl_Interp *interp,		/* Current interpreter. */
  1391   1383       int objc,			/* Number of arguments. */
  1392         -    Tcl_Obj *CONST objv[])	/* Argument values. */
         1384  +    Tcl_Obj *const objv[])	/* Argument values. */
  1393   1385   {
  1394   1386       LRESULT result;
  1395   1387       DWORD_PTR sendResult;
  1396         -    UINT timeout = 3000;
  1397         -    int len;
  1398         -    CONST char *str;
         1388  +    int timeout = 3000;
         1389  +    size_t len;
         1390  +    const char *str;
  1399   1391       Tcl_Obj *objPtr;
         1392  +    WCHAR *wstr;
         1393  +    Tcl_DString ds;
  1400   1394   
  1401         -    if ((objc != 3) && (objc != 5)) {
  1402         -	Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
  1403         -	return TCL_ERROR;
  1404         -    }
  1405         -
  1406         -    if (objc > 3) {
  1407         -	str = Tcl_GetStringFromObj(objv[3], &len);
  1408         -	if ((len < 2) || (*str != '-')
  1409         -		|| strncmp(str, "-timeout", (size_t) len)) {
  1410         -	    Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
  1411         -	    return TCL_ERROR;
         1395  +    if (objc == 3) {
         1396  +	str = Tcl_GetString(objv[1]);
         1397  +	len = objv[1]->length;
         1398  +	if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
         1399  +	    return TCL_BREAK;
  1412   1400   	}
  1413         -	if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
         1401  +	if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
  1414   1402   	    return TCL_ERROR;
  1415   1403   	}
  1416   1404       }
  1417   1405   
  1418         -    str = Tcl_GetStringFromObj(objv[2], &len);
  1419         -    if (len == 0) {
  1420         -	str = NULL;
         1406  +    str = Tcl_GetString(objv[0]);
         1407  +    len = objv[0]->length;
         1408  +    wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
         1409  +    if (Tcl_DStringLength(&ds) == 0) {
         1410  +	wstr = NULL;
  1421   1411       }
  1422   1412   
  1423   1413       /*
  1424   1414        * Use the ignore the result.
  1425   1415        */
  1426   1416   
  1427   1417       result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
  1428         -	    (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
         1418  +	    (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
         1419  +    Tcl_DStringFree(&ds);
  1429   1420   
  1430   1421       objPtr = Tcl_NewObj();
  1431         -    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
  1432         -    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult));
         1422  +    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result));
         1423  +    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult));
  1433   1424       Tcl_SetObjResult(interp, objPtr);
  1434   1425   
  1435   1426       return TCL_OK;
  1436   1427   }
  1437   1428   
  1438   1429   /*
  1439   1430    *----------------------------------------------------------------------
................................................................................
  1454   1445   
  1455   1446   static void
  1456   1447   AppendSystemError(
  1457   1448       Tcl_Interp *interp,		/* Current interpreter. */
  1458   1449       DWORD error)		/* Result code from error. */
  1459   1450   {
  1460   1451       int length;
  1461         -    WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
  1462         -    char *msg;
         1452  +    TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
         1453  +    const char *msg;
  1463   1454       char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
  1464   1455       Tcl_DString ds;
  1465   1456       Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
  1466   1457   
  1467   1458       if (Tcl_IsShared(resultPtr)) {
  1468   1459   	resultPtr = Tcl_DuplicateObj(resultPtr);
  1469   1460       }
  1470         -    length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
         1461  +    length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
  1471   1462   	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
  1472         -	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
         1463  +	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,
  1473   1464   	    0, NULL);
  1474   1465       if (length == 0) {
         1466  +	sprintf(msgBuf, "unknown error: %ld", error);
         1467  +	msg = msgBuf;
         1468  +    } else {
  1475   1469   	char *msgPtr;
  1476   1470   
  1477         -	length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
  1478         -		| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
  1479         -		MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
  1480         -		0, NULL);
  1481         -	if (length > 0) {
  1482         -	    wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR));
  1483         -	    MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr,
  1484         -		    length + 1);
  1485         -	    LocalFree(msgPtr);
  1486         -	}
  1487         -    }
  1488         -    if (length == 0) {
  1489         -	if (error == ERROR_CALL_NOT_IMPLEMENTED) {
  1490         -	    msg = "function not supported under Win32s";
  1491         -	} else {
  1492         -	    sprintf(msgBuf, "unknown error: %ld", error);
  1493         -	    msg = msgBuf;
  1494         -	}
  1495         -    } else {
  1496         -	Tcl_Encoding encoding;
         1471  +	Tcl_WinTCharToUtf(tMsgPtr, -1, &ds);
         1472  +	LocalFree(tMsgPtr);
  1497   1473   
  1498         -	encoding = Tcl_GetEncoding(NULL, "unicode");
  1499         -	Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
  1500         -	Tcl_FreeEncoding(encoding);
  1501         -	LocalFree(wMsgPtr);
  1502         -
  1503         -	msg = Tcl_DStringValue(&ds);
         1474  +	msgPtr = Tcl_DStringValue(&ds);
  1504   1475   	length = Tcl_DStringLength(&ds);
  1505   1476   
  1506   1477   	/*
  1507   1478   	 * Trim the trailing CR/LF from the system message.
  1508   1479   	 */
  1509   1480   
  1510         -	if (msg[length-1] == '\n') {
  1511         -	    msg[--length] = 0;
         1481  +	if (msgPtr[length-1] == '\n') {
         1482  +	    --length;
  1512   1483   	}
  1513         -	if (msg[length-1] == '\r') {
  1514         -	    msg[--length] = 0;
         1484  +	if (msgPtr[length-1] == '\r') {
         1485  +	    --length;
  1515   1486   	}
         1487  +	msgPtr[length] = 0;
         1488  +	msg = msgPtr;
  1516   1489       }
  1517   1490   
  1518   1491       sprintf(id, "%ld", error);
  1519   1492       Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
  1520   1493       Tcl_AppendToObj(resultPtr, msg, length);
  1521   1494       Tcl_SetObjResult(interp, resultPtr);
  1522   1495   
................................................................................
  1543   1516    */
  1544   1517   
  1545   1518   static DWORD
  1546   1519   ConvertDWORD(
  1547   1520       DWORD type,			/* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
  1548   1521       DWORD value)		/* The value to be converted. */
  1549   1522   {
  1550         -    DWORD order = 1;
         1523  +    const DWORD order = 1;
  1551   1524       DWORD localType;
  1552   1525   
  1553   1526       /*
  1554   1527        * Check to see if the low bit is in the first byte.
  1555   1528        */
  1556   1529   
  1557         -    localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
         1530  +    localType = (*((const char *) &order) == 1)
         1531  +	    ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
  1558   1532       return (type != localType) ? (DWORD) SWAPLONG(value) : value;
  1559   1533   }
  1560   1534   
  1561   1535   /*
  1562   1536    * Local Variables:
  1563   1537    * mode: c
  1564   1538    * c-basic-offset: 4
  1565   1539    * fill-column: 78
  1566   1540    * End:
  1567   1541    */