summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/README189
-rw-r--r--win/README.binary518
-rw-r--r--win/makefile.vc488
-rw-r--r--win/pkgIndex.tcl11
-rw-r--r--win/stub16.c198
-rw-r--r--win/tcl.rc42
-rw-r--r--win/tcl16.rc37
-rw-r--r--win/tclWinFCmd.c1401
-rw-r--r--win/tclWinFile.c647
-rw-r--r--win/tclsh.rc36
10 files changed, 0 insertions, 3567 deletions
diff --git a/win/README b/win/README
deleted file mode 100644
index 383cf7e..0000000
--- a/win/README
+++ /dev/null
@@ -1,189 +0,0 @@
-Tcl 8.0.5 for Windows
-
-by Scott Stanton
-Scriptics Corporation
-scott.stanton@scriptics.com
-
-RCS: @(#) $Id: README,v 1.9 1999/02/09 03:31:55 stanton Exp $
-
-1. Introduction
----------------
-
-This is the directory where you configure and compile the Windows
-version of Tcl. This directory also contains source files for Tcl
-that are specific to Microsoft Windows. The rest of this file
-contains information specific to the Windows version of Tcl.
-
-2. Distribution notes
----------------------
-
-Tcl 8.0 for Windows is distributed in binary form in addition to the
-common source release. The binary distribution is a self-extracting
-archive with a built-in installation script.
-
-Look for the binary release in the same location as the source release
-(http://www.scriptics.com/software/8.0.html or any of the mirror
-sites). For most users, the binary release will be much easier to
-install and use. You only need the source release if you plan to
-modify the core of Tcl, or if you need to compile with a different
-compiler. With the addition of the dynamic loading interface, it is
-no longer necessary to have the source distribution in order to build
-and use extensions.
-
-3. Compiling Tcl
-----------------
-
-In order to compile Tcl for Windows, you need the following items:
-
- Tcl 8.0 Source Distribution (plus any patches)
-
- Borland C++ 4.52 (both 16-bit and 32-bit compilers)
- or
- Visual C++ 2.x/4.x/5.x
-
-In practice, the 8.0.5 release is built with Visual C++ 5.0
-
-In the "win" subdirectory of the source release, you will find two
-files called "makefile.bc" and "makefile.vc". These are the makefiles
-for the Borland and Visual C++ compilers respectively. You should
-copy the appropriate one to "makefile" and update the paths at the
-top of the file to reflect your system configuration. Now you can use
-"make" (or "nmake" for VC++) to build the tcl libraries and the tclsh
-executable.
-
-In order to use the binaries generated by these makefiles, you will
-need to place the Tcl script library files someplace where Tcl can
-find them. Tcl looks in one of three places for the library files:
-
- 1) The path specified in the environment variable "TCL_LIBRARY".
-
- 2) In the lib\tcl8.0 directory under the installation directory
- as specified in the registry:
-
- HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0
-
- 3) Relative to the directory containing the current .exe.
- Tcl will look for a directory "..\lib\tcl8.0" relative to the
- directory containing the currently running .exe.
-
-Note that in order to run tclsh80.exe, you must ensure that tcl80.dll
-and tclpip80.dll are on your path, in the system directory, or in the
-directory containing tclsh80.exe.
-
-4. Building Extensions
-----------------------
-
-With the Windows compilers you have to worry about how you export symbols
-from DLLs. tcl.h defines a few macros to help solve this problem:
-
-EXTERN - all Tcl_ function prototypes use this macro, which implies
- they are exported. You'll see this used in tcl.h and tk.h.
- You should use this in your exported procedures.
- However, this is not the whole story.
-TCL_STORAGE_CLASS - this is really an import/export flag, depending on if you are
- importing symbols from a DLL (i.e., a user of the DLL), or if
- you are exporting symbols from the DLL (i.e., you are building it.)
- The EXTERN macro includes TCL_STORAGE_CLASS.
- TCL_STORAGE_CLASS is defined to be either DLLIMPORT or DLLEXPORT as
- described below.
-STATIC_BUILD - define this if you are *not* building a DLL
- (e.g., a main program)
-DLL_BUILD - define this if you *are* building a DLL
-DLLIMPORT - If STATIC_BUILD is defined, this becomes nothing.
- (On UNIX, DLLIMPORT is defined to be empty)
- Otherwise, this this expands to __declspec(dllimport)
-DLLEXPORT - If STATIC_BUILD is defined, this becomes nothing.
- (On UNIX, DLLEXPORT is defined to be empty)
- Otherwise, this this expands to __declspec(dllexport)
-
-EXPORT(type, func)
- For the Borland compiler, you need to export functions differently.
- The DLLEXPORT macro is empty, and instead you need to use
- EXPORT because they had a different order. Your declaration will
- look like
- EXTERN EXPORT(int, Foo_Init)(Tcl_Interp *interp);
-
-We have not defined EXPORT anywhere. You can paste this into your C file:
-
-#ifndef STATIC_BUILD
-#if defined(_MSC_VER)
-# define EXPORT(a,b) __declspec(dllexport) a b
-# define DllEntryPoint DllMain
-#else
-# if defined(__BORLANDC__)
-# define EXPORT(a,b) a _export b
-# else
-# define EXPORT(a,b) a b
-# endif
-#endif
-#endif
-
-
-How to use these:
-
-Assume your extension is named Foo. In its Makefile, define
-BUILD_Foo so that you know you are building Foo and not using it.
-Then, in your main header file, foo.h, conditionally define
-EXPORT to be either DLLIMPORT or DLLEXPORT based on the
-presense of BUILD_Foo, like this:
-
-#ifndef _FOO
-#define _FOO
-#include "tcl.h"
-/* Additional includes go here */
-/*
- * if the BUILD_foo macro is defined, the assumption is that we are
- * building the dynamic library.
- */
-#ifdef BUILD_Foo
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-/*
- * Function prototypes for this module.
- */
-EXTERN int Foo_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Foo_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-/* Additional prototypes go here */
-/*
- * end of foo.h
- * reset TCL_STORAGE_CLASS to DLLIMPORT.
- */
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
-#endif /* _FOO */
-
-In your C file, put EXTERN before then functions you need to export.
-If you use Borland, you'll need to use the old EXPORT macro, too.
-
-5. Test suite
--------------
-
-This distribution contains an extensive test suite for Tcl. Some of
-the tests are timing dependent and will fail from time to time. If a
-test is failing consistently, please send us a bug report with as much
-detail as you can manage.
-
-In order to run the test suite, you build the "test" target using the
-appropriate makefile for your compiler.
-
-
-6. Known Bugs
--------------
-
-Here is the current list of known bugs/missing features for the
-Windows version of Tcl:
-
-- Blocking "after" commands (e.g. "after 3000") don't work on Win32s.
-- Clock command fails to handle daylight savings time boundaries for
- things like "last week".
-- Background processes aren't properly detached on NT.
-- File events only work on sockets.
-- Pipes/files/console/serial ports don't support nonblocking I/O.
-
-If you have comments or bug reports for the Windows version of Tcl,
-please direct them to:
-
-<bugs@scriptics.com>
-
-or post them to the comp.lang.tcl newsgroup.
diff --git a/win/README.binary b/win/README.binary
deleted file mode 100644
index fc8d4a1..0000000
--- a/win/README.binary
+++ /dev/null
@@ -1,518 +0,0 @@
-Tcl/Tk 8.0.5 for Windows, Binary Distribution
-
-%Z% $Id: README.binary,v 1.3 1999/01/04 19:25:05 rjohnson Exp $
-
-1. Introduction
----------------
-
-This directory contains the binary distribution of Tcl/Tk 8.0.5 for
-Windows. It was compiled with Microsoft Visual C++ 5.0 using Win32
-API, so that it will run under Windows NT and Windows 95. The
-information here corresponds to release 8.0. This patch provides
-compatibility with [incr Tcl] 3.0. Tcl 8.0 is a major new release
-that replaces the core of the interpreter with an on-the-fly bytecode
-compiler to improve execution speed. It also includes several other
-new features such as namespaces and binary I/O, plus many bug fixes.
-The compiler introduces a few incompatibilities that may affect
-existing Tcl scripts; the incompatibilities are relatively obscure but
-may require modifications to some old scripts before they can run with
-this version. The compiler introduces many new C-level APIs, but the
-old APIs are still supported. See below for more details. This patch
-release fixes various bugs in Tcl 8.0, plus it adds a few minor
-features to support the TclPro 1.0 tool set and [incr Tcl] 3.0.
-Please check the changes file in the source release for details.
-
-This release also corresponds to Tk 8.0.5. This is a major release with
-significant new features such as native look and feel on Macintoshes
-and PCs, a new font mechanism, application embedding, and proper
-support for Safe-Tcl. See below for details. There should be no
-backward incompatibilities in Tk 8.0.5 that affect scripts.
-
-Note: with this release the Tk version number skips from 4.2 to 8.0.
-The jump was made in order to synchronize the Tcl and Tk version
-numbers.
-
-2. Documentation
-----------------
-
-The best way to get started with Tcl is to read one of the introductory
-books on Tcl:
-
- Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
- Prentice-Hall, 1997, ISBN 0-13-616830-2
-
- Tcl and the Tk Toolkit, by John Ousterhout,
- Addison-Wesley, 1994, ISBN 0-201-63337-X
-
- Exploring Expect, by Don Libes,
- O'Reilly and Associates, 1995, ISBN 1-56592-090-2
-
-Other books are listed at
-http://www.scriptics.com/resource/doc/books/
-http://www.tclconsortium.org/resources/books.html
-
-There is also an official home for Tcl and Tk on the Web:
- http://www.scriptics.com
-These Web pages include information about the latest releases, products
-related to Tcl and Tk, reports on bug fixes and porting issues, HTML
-versions of the manual pages, and pointers to many other Tcl/Tk Web
-pages at other sites. Check them out!
-
-3. Installation
----------------
-
-The binary release is distributed as a self-extracting archive called
-tcl80.exe. The setup program which will prompt you for an
-installation directory. It will create the installation heirarchy
-under the specified directory, and install a wish application icon
-under the program manager group of your choice.
-
-With the 8.0.3 patch release, we are no longer supporting use of
-Tcl with 16-bit versions of Windows. Microsoft has completely dropped
-support of the Win32s subsystem. If you still need 16-bit support,
-you can get win32s and the 16-bit thunking dll (tcl1680.dll) from the
-Scriptics web site at ftp://ftp.scriptics.com/pub/tcl/misc.
-
-4. Summary of changes in Tcl 8.0
---------------------------------
-
-Here are the most significant changes in Tcl 8.0. In addition to these
-changes, there are several smaller changes and bug fixes. See the file
-"changes" for a complete list of all changes.
-
- 1. Bytecode compiler. The core of the Tcl interpreter has been
- replaced with an on-the-fly compiler that translates Tcl scripts to
- byte codes; a new interpreter then executes the byte codes. In
- earlier versions of Tcl, strings were used as a universal
- representation; in Tcl 8.0 strings are replaced with Tcl_Obj
- structures ("objects") that can hold both a string value and an
- internal form such as a binary integer or compiled bytecodes. The
- new objects make it possible to store information in efficient
- internal forms and avoid the constant translations to and from
- strings that occurred with the old interpreter. We have not yet
- converted all of Tcl to take full advantage of the compiler and
- objects and have not converted any of Tk yet, but even so you
- should see speedups of 2-3x on many programs and you may see
- speedups as much as 10-20x in some cases (such as code that
- manipulates long lists). Future releases should achieve even
- greater speedups. The compiler introduces only a few minor changes
- at the level of Tcl scripts, but it introduces many new C APIs for
- managing objects. See, for example, the manual entries doc/*Obj*.3.
-
- 2. Namespaces. There is a new namespace mechanism based on the
- namespace implementation by Michael McLennan of Lucent Technologies.
- This includes new "namespace" and "variable" commands. There are
- many new C APIs associated with namespaces, but they will not be
- exported until Tcl 8.1. Note: the syntax of the namespace command
- has been changed slightly since the b1 release. See the changes
- file for details.
-
- 3. Binary I/O. The new object system in Tcl 8.0 supports binary
- strings (internally, strings are counted in addition to being null
- terminated). There is a new "binary" command for inserting and
- extracting data to/from binary strings. Commands such as "puts",
- "gets", and "read" commands now operate correctly on binary data.
- There is a new variable tcl_platform(byteOrder) to identify the
- native byte order for the current host.
-
- 4. Random numbers. The "expr" command now contains a random number
- generator, which can be accessed via the "rand()" and "srand()" math
- functions.
-
- 5. Safe-Tcl enhancements. There is a new "hidden command"
- mechanism, implemented with the Tcl commands "interp hide", "interp
- expose", "interp invokehidden", and "interp hidden" and the C APIs
- Tcl_HideCommand and Tcl_ExposeCommand. There is now support for
- loadable security policies, including new library procedures such as
- tcl_safeCreateInterp.
-
- 6. There is a new package "registry" available under Windows for
- accessing the Windows registry.
-
- 7. There is a new command "file attributes" for getting and setting
- things like permissions and owner. There is also a new command
- "file nativename" for getting back the platform-specific name for a
- particular file.
-
- 8. There is a new "fcopy" command to copy data between channels.
- This replaces and improves upon the not-so-secret unsupported old
- command "unsupported0".
-
- 9. There is a new package "http" for doing GET, POST, and HEAD
- requests via the HTTP/1.0 protocol. See the manual entry http.n
- for details.
-
- 10. There are new library procedures for finding word breaks in
- strings. See the manual entry library.n for details.
-
- 11. There are new C APIs Tcl_Finalize (for cleaning up before
- unloading the Tcl DLL) and Tcl_Ungets for pushing bytes back into a
- channel's input buffer.
-
- 12. Tcl now supports serial I/O devices on Windows and Unix, with a
- new fconfigure -mode option. The Windows driver does not yet
- support event-driven I/O.
-
- 13. The lsort command has new options -dictionary and -index. The
- -index option allows for very rapid sorting based on an element
- of a list.
-
- 14. The event notifier has been completely rewritten (again). It
- should now allow Tcl to use an external event loop (like Motif's)
- when it is embedded in other applications. No script-level
- interfaces have changed, but many of the C APIs have.
-
-Tcl 8.0 introduces the following incompatibilities that may affect Tcl
-scripts that worked under Tcl 7.6 and earlier releases:
-
- 1. Variable and command names may not include the character sequence
- "::" anymore: this sequence is now used as a namespace separator.
-
- 2. The semantics of some Tcl commands have been changed slightly to
- maximize performance under the compiler. These incompatibilities
- are documented on the Web so that we can keep the list up-to-date.
- See the URL http://www.sunlabs.com/research/tcl/compiler.html.
-
- 3. 2-digit years are now parsed differently by the "clock" command
- to handle year 2000 issues better (years 00-38 are treated as
- 2000-2038 instead of 1900-1938).
-
- 4. The old Macintosh commands "cp", "mkdir", "mv", "rm", and "rmdir"
- are no longer supported; all of these features are now available on
- all platforms via the "file" command.
-
- 5. The variable tcl_precision is now shared between interpreters
- and defaults to 12 digits instead of 6; safe interpreters cannot
- modify tcl_precision. The new object system in Tcl 8.0 causes
- floating-to-string conversions (and the associated rounding) to
- occur much less often than in Tcl 7.6, which can sometimes cause
- behavioral changes.
-
- 6. The C APIs associated with the notifier have changed substantially.
-
- 7. The procedures Tcl_CreateModalTimeout and Tcl_DeleteModalTimeout
- have been removed.
-
- 8. Tcl_CreateFileHandler and Tcl_DeleteFileHandler now take Unix
- fd's and are only supported on the Unix platform. Please use the
- Tcl_CreateChannelHandler interface instead.
-
- 9. The C APIs for creating channel drivers have changed as part of
- the new notifier implementation. The Tcl_File interfaces have been
- removed. Tcl_GetChannelFile has been replaced with
- Tcl_GetChannelHandle. Tcl_MakeFileChannel now takes a platform-
- specific file handle. Tcl_DriverGetOptionProc procedures now take
- an additional interp argument.
-
-5. Summary of changes in Tk 8.0
--------------------------------
-
-Here is a list of the most important new features in Tk 8.0. The
-release also includes several smaller feature changes and bug fixes.
-See the "changes" file for a complete list of all changes.
-
- 1. Native look and feel. The widgets have been rewritten to provide
- (nearly?) native look and feel on the Macintosh and PC. Many
- widgets, including scrollbars, menus, and the button family, are
- implemented with native platform widgets. Others, such as entries
- and texts, have been modified to emulate native look and feel.
- These changes are backwards compatible except that (a) some
- configuration options are now ignored on some platforms and (b) you
- must use the new menu mechanism described below to native look and
- feel for menus.
-
- 2. There is a new interface for creating menus, where a menubar is
- implemented as a menu widget instead of a frame containing menubuttons.
- The -menu option for a toplevel is used to specify the name of the
- menubar; the menu will be displayed *outside* the toplevel using
- different mechanisms on each platform (e.g. on the Macintosh the menu
- will appear at the top of the screen). See the menu demos in the
- widget demo for examples. The old style of menu still works, but
- does not provide native look and feel. Menus have several new
- features:
- - New "-columnbreak" and "-hideMargin" options make it possible
- to create multi-column menus.
- - It is now possible to manipulate the Apple and Help menus on
- the Macintosh, and the system menu on Windows. It is also
- possible to have a right justified Help menu on Unix.
- - Menus now issue the virtual event <<MenuSelect>> whenever the
- current item changes. Applications can use this to generate
- help messages.
- - There is a new "-direction" option for menubuttons, which
- controls where the menu pops up revenues to the button.
-
- 3. The font mechanism in Tk has been completely reworked:
- - Font names need not be nasty X LFDs: more intuitive names
- like {Times 12 Bold} can also be used. See the manual entry
- font.n for details.
- - Font requests always succeed now. If the requested font is
- not available, Tk finds the closest available font and uses
- that one.
- - Tk now supports named fonts whose precise attributes can be
- changed dynamically. If a named font is changed, any widget
- using that font updates itself to reflect the change.
- - There is a new command "font" for creating named fonts and
- querying various information about fonts.
- - There are now officially supported C APIs for measuring and
- displaying text. If you use these APIs now, your code will
- automatically handle international text when internationalization
- is added to Tk in a future release. See the manual entries
- MeasureChar.3, TextLayout.3, and FontId.3.
- - The old C procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
- and Tk_FreeFontStruct have been replaced with more portable
- procedures Tk_GetFont, Tk_NameOfFont, and Tk_FreeFont.
-
- 4. Application embedding. It is now possible to embedded one Tcl/Tk
- application inside another, using the -container option on frame
- widgets and the -use option for toplevel widgets or on the command
- line for wish. Embedding should be fully functional under Unix,
- but the implementation is incomplete on the Macintosh and PC.
-
- 5. Tk now works correctly with Safe-Tcl: it can be loaded into
- safe interpreters.
-
- 6. Text widgets now allow images to be embedded directly in the
- text without using embedded windows. This is more efficient and
- provides smoother scrolling.
-
- 7. Buttons have a new -default option for drawing default rings in
- a platform-specific manner.
-
- 8. There is a new "gray75" bitmap, and the "gray25" bitmap is now
- really 25% on (due to an ancient mistake, it had been only 12% on).
- The Macintosh now supports native bitmaps, including new builtin
- bitmaps "stop", "caution", and "note", plus the ability to use
- bitmaps in the application's resource fork.
-
- 9. The "destroy" command now ignores windows that don't exist
- instead of generating an error.
-
-Tk 8.0 introduces the following incompatibilities that may affect Tcl/Tk
-scripts that worked under Tk 4.2 and earlier releases:
-
- 1. Font specifications such as "Times 12" now interpret the size
- as points, whereas it used to be pixels (this was actually a bug,
- since the behavior was documented as points). To get pixels now,
- use a negative size such as "Times -12".
-
- 2. The -transient option for menus is no longer supported. You can
- achieve the same effect with the -type field.
-
- 3. In the canvas "coords" command, polygons now return only the
- points that were explicitly specified when the polygon was created
- (they used to return an extra point if the polygon wasn't originally
- closed). Internally, polygons are still closed automatically for
- purposes of display and hit detection; the extra point just isn't
- returned by the "coords" command.
-
- 4. The photo image mechanism now uses Tcl_Channels instead of FILEs,
- in order to make it portable. FILEs are no longer used anywhere
- in Tk.
-
- 5. The procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
- and Tk_FreeFontStruct have been removed.
-
-Note: the new compiler in Tcl 8.0 may also affect Tcl/Tk scripts; check
-the Tcl documentation for information on incompatibilities introduced by
-Tcl 8.0.
-
-6. Known Bugs/Missing Features
-------------------------------
-
-- Blocking "after" commands (e.g. "after 3000") don't work on Win32s.
-- Clock command fails to handle daylight savings time boundaries for
- things like "last week".
-- Background processes aren't properly detached on NT.
-- File events only work on sockets.
-- Pipes/files/console/serial ports don't support nonblocking I/O.
-- The library cannot be used by two processes at the same time under
- Win32s.
-- There is no support for custom cursors/application icons. The core
- set of X cursors is supported, although you cannot change their color.
-- Stippling of arcs isn't implemented yet.
-- Some "wm" functions don't map to Windows and aren't implemented;
- others should map, but just aren't implemented. The worst offenders
- are the icon manipulation routines.
-- Under Win32s, you can only start one instance of Wish at a time.
-- Color management on some displays doesn't work properly resulting in
- Tk switching to monochrome mode.
-- Tk seems to fail to draw anything on some Matrox Millenium cards.
-- Send and winfo interps are not currently supported
-- Printing does not work for images (e.g. GIF) on a canvas.
-- Tk_dialog appears in the upper left corner. This is a symptom of a
- larger problem with "wm geometry" when applied to unmapped or
- iconified windows.
-- Some keys don't work on international keyboards.
-- Grabs do not affect native menus or the title bar.
-- PPM images are using the wrong translation mode for writing to
- files, resulting in CR/LF terminated PPM files.
-- Tk crashes if the display depth changes while it is running. Tk
- also doesn't consistently track changes in the system colors.
-
-There may be more that we don't know about, so be sure to submit bug
-reports when you run into problems. If you have comments or bug
-reports for the Windows version of Tcl, please direct them to:
-
-Scott Stanton
-scott.stanton@eng.sun.com
-
-or post them to the newsgroup comp.lang.tcl.
-
-7. Tcl newsgroup
------------------
-
-There is a network news group "comp.lang.tcl" intended for the exchange
-of information about Tcl, Tk, and related applications. Feel free to use
-the newsgroup both for general information questions and for bug reports.
-We read the newsgroup and will attempt to fix bugs and problems reported
-to it.
-
-When using comp.lang.tcl, please be sure that your e-mail return address
-is correctly set in your postings. This allows people to respond directly
-to you, rather than the entire newsgroup, for answers that are not of
-general interest. A bad e-mail return address may prevent you from
-getting answers to your questions. You may have to reconfigure your news
-reading software to ensure that it is supplying valid e-mail addresses.
-
-8. Tcl contributed archive
---------------------------
-
-Many people have created exciting packages and applications based on Tcl
-and/or Tk and made them freely available to the Tcl community. An archive
-of these contributions is kept on the machine ftp.neosoft.com. You
-can access the archive using anonymous FTP; the Tcl contributed archive is
-in the directory "/pub/tcl". The archive also contains several FAQ
-("frequently asked questions") documents that provide solutions to problems
-that are commonly encountered by TCL newcomers.
-
-9. Tcl Resource Center
-----------------------
-Visit http://www.scritics.com/resource/ to see an annotated index of
-many Tcl resources available on the World Wide Web. This includes
-papers, books, and FAQs, as well as extensions, applications, binary
-releases, and patches. You can contribute patches by sending them
-to <patches@scriptics.com>. You can also recommend more URLs for the
-resource center using the forms labeled "Add a Resource".
-
-10. Mailing lists
-----------------
-
-A couple of Mailing List have been set up to discuss Macintosh or
-Windows related Tcl issues. In order to use these Mailing Lists you
-must have access to the internet. To subscribe send a message to:
-
- wintcl-request@tclconsortium.org
- mactcl-request@tclconsortium.org
-
-In the body of the message (the subject will be ignored) put:
-
- subscribe mactcl Joe Blow
-
-Replacing Joe Blow with your real name, of course. (Use wintcl
-instead of mactcl if your interested in the Windows list.) If you
-would just like to receive more information about the list without
-subscribing put the line:
-
- information mactcl
-
-in the body instead (or wintcl).
-
-10. Support and bug fixes
-------------------------
-
-We're very interested in receiving bug reports and suggestions for
-improvements. We prefer that you send this information to the
-comp.lang.tcl newsgroup rather than to any of us at Sun. We'll see
-anything on comp.lang.tcl, and in addition someone else who reads
-comp.lang.tcl may be able to offer a solution. The normal turn-around
-time for bugs is 2-4 weeks. Enhancements may take longer and may not
-happen at all unless there is widespread support for them (we're
-trying to slow the rate at which Tcl turns into a kitchen sink). It's
-very difficult to make incompatible changes to Tcl at this point, due
-to the size of the installed base.
-
-When reporting bugs, please provide a short tclsh script that we can
-use to reproduce the bug. Make sure that the script runs with a
-bare-bones tclsh and doesn't depend on any extensions or other
-programs, particularly those that exist only at your site. Also,
-please include three additional pieces of information with the
-script:
- (a) how do we use the script to make the problem happen (e.g.
- what things do we click on, in what order)?
- (b) what happens when you do these things (presumably this is
- undesirable)?
- (c) what did you expect to happen instead?
-
-The Tcl community is too large for us to provide much individual
-support for users. If you need help we suggest that you post questions
-to comp.lang.tcl. We read the newsgroup and will attempt to answer
-esoteric questions for which no-one else is likely to know the answer.
-In addition, Tcl support and training are available commercially from
-NeoSoft (info@neosoft.com), Computerized Processes Unlimited
-(gwl@cpu.com), and Data Kinetics (education@dkl.com).
-
-11. Tcl version numbers
-----------------------
-
-Each Tcl release is identified by two numbers separated by a dot, e.g.
-6.7 or 7.0. If a new release contains changes that are likely to break
-existing C code or Tcl scripts then the major release number increments
-and the minor number resets to zero: 6.0, 7.0, etc. If a new release
-contains only bug fixes and compatible changes, then the minor number
-increments without changing the major number, e.g. 7.1, 7.2, etc. If
-you have C code or Tcl scripts that work with release X.Y, then they
-should also work with any release X.Z as long as Z > Y.
-
-Alpha and beta releases have an additional suffix of the form b1 or b1.
-For example, Tcl 7.0b1 is the first beta release of Tcl version 7.0,
-Tcl 7.0b2 is the second beta release, and so on. A beta release is an
-initial version of a new release, used to fix bugs and bad features before
-declaring the release stable. An alpha release is like a beta release,
-except it's likely to need even more work before it's "ready for prime
-time". New releases are normally preceded by one or more alpha and beta
-releases. We hope that lots of people will try out the alpha and beta
-releases and report problems. We'll make new alpha/beta releases to fix
-the problems, until eventually there is a beta release that appears to
-be stable. Once this occurs we'll make the final release.
-
-We can't promise to maintain compatibility among alpha and beta releases.
-For example, release 7.1b2 may not be backward compatible with 7.1b1, even
-though the final 7.1 release will be backward compatible with 7.0. This
-allows us to change new features as we find problems during beta testing.
-We'll try to minimize incompatibilities between beta releases, but if
-a major problem turns up then we'll fix it even if it introduces an
-incompatibility. Once the official release is made then there won't
-be any more incompatibilities until the next release with a new major
-version number.
-
-Patch releases have a suffix such as p1 or p2. These releases contain
-bug fixes only. A patch release (e.g Tcl 7.6p2) should be completely
-compatible with the base release from which it is derived (e.g. Tcl
-7.6), and you should normally use the highest available patch release.
-
-As of 8.0.3, the patch releases use a second . instead of 'p'. So, the
-8.0 release went to 8.0p1, 8.0p2, and 8.0.3. The alphas and betas will
-still use the 'a' and 'b' letters in their tcl_patchLevel.
-
-12. Linking against the binary release
---------------------------------------
-
-In order to link your applications against the .dll files shipped with
-this release, you will need to use the appropriate .lib file for your
-compiler. In the lib directory of the installation directory, there
-are library files for the Microsoft Visual C++ compiler:
-
- tcl80vc.lib
- tk80vc.lib
-
-13. Building dynamically loadable extensions
---------------------------------------------
-
-Please refer to the example dynamically loadable extension provided on
-our ftp site:
-
- ftp://ftp.scriptics.com/pub/tcl/misc/example.zip
-
-This archive contains a template that you can use for building
-extensions that will be loadable on Unix, Windows, and Macintosh
-systems.
diff --git a/win/makefile.vc b/win/makefile.vc
deleted file mode 100644
index c054590..0000000
--- a/win/makefile.vc
+++ /dev/null
@@ -1,488 +0,0 @@
-# Visual C++ 2.x and 4.0 makefile
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# RCS: @(#) $Id: makefile.vc,v 1.24 1999/02/03 02:59:17 stanton Exp $
-
-# Does not depend on the presence of any environment variables in
-# order to compile tcl; all needed information is derived from
-# location of the compiler directories.
-
-#
-# Project directories
-#
-# ROOT = top of source tree
-#
-# TOOLS32 = location of VC++ 32-bit development tools. Note that the
-# VC++ 2.0 header files are broken, so you need to use the
-# ones that come with the developer network CD's, or later
-# versions of VC++.
-#
-# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
-# library. This information is optional; if the 16-bit compiler
-# is not available, then the 16-bit code will not be built.
-# Tcl will still run without the 16-bit code, but...
-# A. Under Windows 3.X you will any calls to the exec command
-# will return an error.
-# B. A 16-bit program to test the behavior of the exec
-# command under NT and 95 will not be built.
-# INSTALLDIR = where the install- targets should copy the binaries and
-# support files
-#
-
-ROOT = ..
-TOOLS32 = c:\program files\devstudio\vc
-TOOLS32_rc = c:\program files\devstudio\sharedide
-TOOLS16 = c:\msvc
-
-INSTALLDIR = c:\programa files\Tcl
-
-# Set this to the appropriate value of /MACHINE: for your platform
-MACHINE = IX86
-
-# Set NODEBUG to 0 to compile with symbols
-NODEBUG = 1
-
-# The following defines can be used to control the amount of debugging
-# code that is added to the compilation.
-#
-# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
-# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
-# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
-# -DUSE_NATIVEMALLOC Disables the Tcl memory allocator in favor
-# of the native malloc implementation. This is
-# needed when using Purify.
-#
-#DEBUGDEFINES = -DTCL_MEM_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG
-#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_NATIVEMALLOC
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-NAMEPREFIX = tcl
-DOTVERSION = 8.0
-VERSION = 80
-
-BINROOT = .
-!IF "$(NODEBUG)" == "1"
-TMPDIRNAME = Release
-DBGX =
-!ELSE
-TMPDIRNAME = Debug
-DBGX = d
-!ENDIF
-TMPDIR = $(BINROOT)\$(TMPDIRNAME)
-OUTDIRNAME = $(TMPDIRNAME)
-OUTDIR = $(TMPDIR)
-
-TCLLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
-TCLDLLNAME = $(NAMEPREFIX)$(VERSION)$(DBGX).dll
-TCLDLL = $(OUTDIR)\$(TCLDLLNAME)
-TCLPLUGINLIB = $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
-TCLPLUGINDLLNAME= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
-TCLPLUGINDLL = $(OUTDIR)\$(TCLPLUGINDLLNAME)
-TCL16DLL = $(OUTDIR)\$(NAMEPREFIX)16$(VERSION)$(DBGX).dll
-TCLSH = $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
-TCLSHP = $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
-TCLPIPEDLLNAME = $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
-TCLPIPEDLL = $(OUTDIR)\$(TCLPIPEDLLNAME)
-TCLREGDLLNAME = $(NAMEPREFIX)reg$(VERSION)$(DBGX).dll
-TCLREGDLL = $(OUTDIR)\$(TCLREGDLLNAME)
-TCLTEST = $(OUTDIR)\$(NAMEPREFIX)test.exe
-DUMPEXTS = $(TMPDIR)\dumpexts.exe
-CAT16 = $(TMPDIR)\cat16.exe
-CAT32 = $(TMPDIR)\cat32.exe
-
-LIB_INSTALL_DIR = $(INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(INSTALLDIR)\bin
-SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\tcl$(DOTVERSION)
-INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
-
-TCLSHOBJS = \
- $(TMPDIR)\tclAppInit.obj
-
-TCLTESTOBJS = \
- $(TMPDIR)\tclTest.obj \
- $(TMPDIR)\tclTestObj.obj \
- $(TMPDIR)\tclTestProcBodyObj.obj \
- $(TMPDIR)\tclWinTest.obj \
- $(TMPDIR)\testMain.obj
-
-TCLOBJS = \
- $(TMPDIR)\panic.obj \
- $(TMPDIR)\regexp.obj \
- $(TMPDIR)\strftime.obj \
- $(TMPDIR)\tclAlloc.obj \
- $(TMPDIR)\tclAsync.obj \
- $(TMPDIR)\tclBasic.obj \
- $(TMPDIR)\tclBinary.obj \
- $(TMPDIR)\tclCkalloc.obj \
- $(TMPDIR)\tclClock.obj \
- $(TMPDIR)\tclCmdAH.obj \
- $(TMPDIR)\tclCmdIL.obj \
- $(TMPDIR)\tclCmdMZ.obj \
- $(TMPDIR)\tclCompExpr.obj \
- $(TMPDIR)\tclCompile.obj \
- $(TMPDIR)\tclDate.obj \
- $(TMPDIR)\tclEnv.obj \
- $(TMPDIR)\tclEvent.obj \
- $(TMPDIR)\tclExecute.obj \
- $(TMPDIR)\tclFCmd.obj \
- $(TMPDIR)\tclFileName.obj \
- $(TMPDIR)\tclGet.obj \
- $(TMPDIR)\tclHash.obj \
- $(TMPDIR)\tclHistory.obj \
- $(TMPDIR)\tclIndexObj.obj \
- $(TMPDIR)\tclInterp.obj \
- $(TMPDIR)\tclIO.obj \
- $(TMPDIR)\tclIOCmd.obj \
- $(TMPDIR)\tclIOSock.obj \
- $(TMPDIR)\tclIOUtil.obj \
- $(TMPDIR)\tclLink.obj \
- $(TMPDIR)\tclListObj.obj \
- $(TMPDIR)\tclLoad.obj \
- $(TMPDIR)\tclMain.obj \
- $(TMPDIR)\tclNamesp.obj \
- $(TMPDIR)\tclNotify.obj \
- $(TMPDIR)\tclObj.obj \
- $(TMPDIR)\tclParse.obj \
- $(TMPDIR)\tclPipe.obj \
- $(TMPDIR)\tclPkg.obj \
- $(TMPDIR)\tclPosixStr.obj \
- $(TMPDIR)\tclPreserve.obj \
- $(TMPDIR)\tclResolve.obj \
- $(TMPDIR)\tclProc.obj \
- $(TMPDIR)\tclStringObj.obj \
- $(TMPDIR)\tclTimer.obj \
- $(TMPDIR)\tclUtil.obj \
- $(TMPDIR)\tclVar.obj \
- $(TMPDIR)\tclWin32Dll.obj \
- $(TMPDIR)\tclWinChan.obj \
- $(TMPDIR)\tclWinError.obj \
- $(TMPDIR)\tclWinFCmd.obj \
- $(TMPDIR)\tclWinFile.obj \
- $(TMPDIR)\tclWinInit.obj \
- $(TMPDIR)\tclWinLoad.obj \
- $(TMPDIR)\tclWinMtherr.obj \
- $(TMPDIR)\tclWinNotify.obj \
- $(TMPDIR)\tclWinPipe.obj \
- $(TMPDIR)\tclWinSock.obj \
- $(TMPDIR)\tclWinTime.obj
-
-cc32 = "$(TOOLS32)\bin\cl.exe"
-link32 = "$(TOOLS32)\bin\link.exe"
-rc32 = "$(TOOLS32_rc)\bin\rc.exe"
-include32 = -I"$(TOOLS32)\include"
-
-cc16 = "$(TOOLS16)\bin\cl.exe"
-link16 = "$(TOOLS16)\bin\link.exe"
-rc16 = "$(TOOLS16)\bin\rc.exe"
-include16 = -I"$(TOOLS16)\include"
-
-WINDIR = $(ROOT)\win
-GENERICDIR = $(ROOT)\generic
-
-TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR)
-TCL_DEFINES = -D__WIN32__ $(DEBUGDEFINES)
-
-TCL_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
- $(TCL_INCLUDES) $(TCL_DEFINES)
-CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
-DOS_CFLAGS = $(cdebug) $(cflags) $(include16) -AL
-DLL16_CFLAGS = $(cdebug) $(cflags) $(include16) -ALw
-
-######################################################################
-# Link flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-ldebug = /RELEASE
-!ELSE
-ldebug = -debug:full -debugtype:cv
-!ENDIF
-
-# declarations common to all linker options
-lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
-
-# declarations for use on Intel i386, i486, and Pentium systems
-!IF "$(MACHINE)" == "IX86"
-DLLENTRY = @12
-lflags = $(lcommon) /MACHINE:$(MACHINE)
-!ELSE
-lflags = $(lcommon) /MACHINE:$(MACHINE)
-!ENDIF
-
-conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
-guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
-dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
-
-!IF "$(MACHINE)" == "PPC"
-libc = libc$(DBGX).lib
-libcdll = crtdll$(DBGX).lib
-!ELSE
-libc = libc$(DBGX).lib oldnames.lib
-libcdll = msvcrt$(DBGX).lib oldnames.lib
-!ENDIF
-
-baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib
-winlibs = $(baselibs) gdi32.lib comdlg32.lib winspool.lib
-
-guilibs = $(libc) $(winlibs)
-conlibs = $(libc) $(baselibs)
-guilibsdll = $(libcdll) $(winlibs)
-conlibsdll = $(libcdll) $(baselibs)
-
-######################################################################
-# Compile flags
-######################################################################
-
-!IF "$(NODEBUG)" == "1"
-# This cranks the optimization level to maximize speed
-cdebug = -O2 -Gs -GD
-!ELSE
-cdebug = -Z7 -Od -WX
-!ENDIF
-
-# declarations common to all compiler options
-ccommon = -c -W3 -nologo -YX -Fp$(TMPDIR)\ -Dtry=__try -Dexcept=__except
-
-!IF "$(MACHINE)" == "IX86"
-cflags = $(ccommon) -D_X86_=1
-!ELSE
-!IF "$(MACHINE)" == "MIPS"
-cflags = $(ccommon) -D_MIPS_=1
-!ELSE
-!IF "$(MACHINE)" == "PPC"
-cflags = $(ccommon) -D_PPC_=1
-!ELSE
-!IF "$(MACHINE)" == "ALPHA"
-cflags = $(ccommon) -D_ALPHA_=1
-!ENDIF
-!ENDIF
-!ENDIF
-!ENDIF
-
-cvars = -DWIN32 -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
-
-!IF "$(NODEBUG)" == "1"
-cvarsdll = $(cvars) -MD
-!ELSE
-cvarsdll = $(cvars) -MDd
-!ENDIF
-
-######################################################################
-# Project specific targets
-######################################################################
-
-release: setup $(TCLSH) dlls
-dlls: setup $(TCL16DLL) $(TCLPIPEDLL) $(TCLREGDLL)
-all: setup $(TCLSH) dlls $(CAT16) $(CAT32)
-tcltest: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
-plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
-install: install-binaries install-libraries
-test: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
- copy $(WINDIR)\pkgIndex.tcl $(OUTDIR)
- set TCL_LIBRARY=$(ROOT)/library
- $(TCLTEST) << "$(TCLREGDLL)"
- load [lindex $$argv 0] registry
- cd ../tests
- source all
-<<
-
-setup:
- @mkd $(TMPDIR)
- @mkd $(OUTDIR)
-
-$(DUMPEXTS): $(WINDIR)\winDumpExts.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
- $(TMPDIR)\winDumpExts.obj
-
-$(TCLLIB): $(TCLDLL)
-
-$(TCLDLL): $(TCLOBJS) $(TMPDIR)\tcl.def $(TMPDIR)\tcl.res
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tcl.def \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
-$(TCLOBJS)
-<<
-
-$(TCLPLUGINLIB): $(TCLPLUGINDLL)
-
-$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\plugin.def $(TMPDIR)\tcl.res
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
- -out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @<<
-$(TCLOBJS)
-<<
-
-$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLLIB) $(TCLSHOBJS)
-
-$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)
-
-$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\tclsh.res
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
- -out:$@ $(conlibsdll) $(TCLLIB) $(TCLTESTOBJS)
-
-$(TCL16DLL): $(WINDIR)\tcl16.rc $(WINDIR)\tclWin16.c
- if exist $(cc16) $(cc16) @<<
-$(DLL16_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\tclWin16.c
-<<
- @copy << $(TMPDIR)\tclWin16.def > nul
-LIBRARY $(@B);dll
-EXETYPE WINDOWS
-CODE PRELOAD MOVEABLE DISCARDABLE
-DATA PRELOAD MOVEABLE SINGLE
-HEAPSIZE 1024
-EXPORTS
- WEP @1 RESIDENTNAME
- UTPROC @2
-<<
- if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOE @<<
-$(TMPDIR)\tclWin16.obj
-$@
-nul
-$(TOOLS16)\lib\ ldllcew oldnames libw toolhelp
-$(TMPDIR)\tclWin16.def
-<<
- if exist $(cc16) $(rc16) -i $(GENERICDIR) $(TCL_DEFINES) $(WINDIR)\tcl16.rc $@
-
-$(TCLPIPEDLL): $(WINDIR)\stub16.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $(WINDIR)\stub16.c
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(conlflags) -out:$@ $(TMPDIR)\stub16.obj $(guilibs)
-
-$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj
- set LIB="$(TOOLS32)\lib"
- $(link32) $(ldebug) $(dlllflags) -out:$@ $(TMPDIR)\tclWinReg.obj \
- $(conlibsdll) $(TCLLIB)
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB="$(TOOLS32)\lib"
- $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
-
-$(CAT16): $(WINDIR)\cat.c
- if exist $(cc16) $(cc16) $(DOS_CFLAGS) -Fo$(TMPDIR)\ $?
- set LIB="$(TOOLS16)\lib"
- if exist $(cc16) $(link16) /NOLOGO /ONERROR:NOEXE /NOI /STACK:16384 \
- $(TMPDIR)\cat.obj,$@,nul,llibce.lib,nul
-
-$(TMPDIR)\tcl.def: $(DUMPEXTS) $(TCLOBJS)
- $(DUMPEXTS) -o $@ $(TCLDLLNAME) @<<
-$(TCLOBJS)
-<<
-
-$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TCLOBJS)
- $(DUMPEXTS) -o $@ $(TCLPLUGINDLLNAME) @<<
-$(TCLOBJS)
-<<
-
-install-binaries: $(TCLSH)
- @mkd $(BIN_INSTALL_DIR)
- @mkd $(LIB_INSTALL_DIR)
- @echo installing $(TCLDLLNAME)
- @copy $(TCLDLL) $(BIN_INSTALL_DIR)
- @copy $(TCLLIB) $(LIB_INSTALL_DIR)
- @echo installing $(TCLSH)
- @copy $(TCLSH) $(BIN_INSTALL_DIR)
- @echo installing $(TCLPIPEDLLNAME)
- @copy $(TCLPIPEDLL) $(BIN_INSTALL_DIR)
- @echo installing $(TCLREGDLLNAME)
- @copy $(TCLREGDLL) $(LIB_INSTALL_DIR)
-
-install-libraries:
- -@mkd $(LIB_INSTALL_DIR)
- -@mkd $(INCLUDE_INSTALL_DIR)
- -@mkd $(SCRIPT_INSTALL_DIR)
- -@mkd $(SCRIPT_INSTALL_DIR)\http1.0
- @copy << "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-package ifneeded registry 1.0 "load [list [file join $$dir .. $(TCLREGDLLNAME)]] registry"
-<<
- -@copy $(ROOT)\library\http1.0\http.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- -@copy $(ROOT)\library\http1.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- -@mkd $(SCRIPT_INSTALL_DIR)\http2.0
- -@copy $(ROOT)\library\http2.0\http.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- -@copy $(ROOT)\library\http2.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- -@mkd $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(ROOT)\library\opt0.1\optparse.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(ROOT)\library\opt0.1\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- -@copy $(GENERICDIR)\tcl.h $(INCLUDE_INSTALL_DIR)
- -@copy $(ROOT)\library\history.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\init.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\ldAout.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\parray.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\safe.tcl $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\tclIndex $(SCRIPT_INSTALL_DIR)
- -@copy $(ROOT)\library\word.tcl $(SCRIPT_INSTALL_DIR)
-
-#
-# Special case object file targets
-#
-
-$(TMPDIR)\tclWinInit.obj: $(WINDIR)\tclWinInit.c
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) $(EXTFLAGS) \
- -Fo$(TMPDIR)\ $?
-
-$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$(TMPDIR)\testMain.obj $?
-
-$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-#
-# Implicit rules
-#
-
-{$(WINDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
- $(cc32) -DDLL_BUILD -DBUILD_tcl $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
-
-{$(WINDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -D__WIN32__ \
- $(TCL_DEFINES) $<
-
-clean:
- -@del $(OUTDIR)\*.exp
- -@del $(OUTDIR)\*.lib
- -@del $(OUTDIR)\*.dll
- -@del $(OUTDIR)\*.exe
- -@del $(OUTDIR)\*.pdb
- -@del $(TMPDIR)\*.pch
- -@del $(TMPDIR)\*.obj
- -@del $(TMPDIR)\*.res
- -@del $(TMPDIR)\*.def
- -@del $(TMPDIR)\*.exe
- -@rmd $(OUTDIR)
- -@rmd $(TMPDIR)
diff --git a/win/pkgIndex.tcl b/win/pkgIndex.tcl
deleted file mode 100644
index 3a9465c..0000000
--- a/win/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.0
-# This file contains package information for Windows-specific extensions.
-#
-# Copyright (c) 1997 by Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pkgIndex.tcl,v 1.2 1998/09/14 18:40:19 stanton Exp $
-
-package ifneeded registry 1.0 [list tclPkgSetup $dir registry 1.0 {{tclreg80.dll load registry}}]
diff --git a/win/stub16.c b/win/stub16.c
deleted file mode 100644
index 44e18d6..0000000
--- a/win/stub16.c
+++ /dev/null
@@ -1,198 +0,0 @@
-/*
- * stub16.c
- *
- * A helper program used for running 16-bit DOS applications under
- * Windows 95.
- *
- * Copyright (c) 1996 by Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: stub16.c,v 1.2 1998/09/14 18:40:19 stanton Exp $
- */
-
-#define STRICT
-
-#include <windows.h>
-#include <stdio.h>
-
-static HANDLE CreateTempFile(void);
-
-/*
- *---------------------------------------------------------------------------
- *
- * main
- *
- * Entry point for the 32-bit console mode app used by Windows 95 to
- * help run the 16-bit program specified on the command line.
- *
- * 1. EOF on a pipe that connects a detached 16-bit process and a
- * 32-bit process is never seen. So, this process runs the 16-bit
- * process _attached_, and then it is run detached from the calling
- * 32-bit process.
- *
- * 2. If a 16-bit process blocks reading from or writing to a pipe,
- * it never wakes up, and eventually brings the whole system down
- * with it if you try to kill the process. This app simulates
- * pipes. If any of the stdio handles is a pipe, this program
- * accumulates information into temp files and forwards it to or
- * from the DOS application as appropriate. This means that this
- * program must receive EOF from a stdin pipe before it will actually
- * start the DOS app, and the DOS app must finish generating stdout
- * or stderr before the data will be sent to the next stage of the
- * pipe. If the stdio handles are not pipes, no accumulation occurs
- * and the data is passed straight through to and from the DOS
- * application.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The child process is created and this process waits for it to
- * complete.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-main()
-{
- DWORD dwRead, dwWrite;
- char *cmdLine;
- HANDLE hStdInput, hStdOutput, hStdError;
- HANDLE hFileInput, hFileOutput, hFileError;
- STARTUPINFO si;
- PROCESS_INFORMATION pi;
- char buf[8192];
- DWORD result;
-
- hFileInput = INVALID_HANDLE_VALUE;
- hFileOutput = INVALID_HANDLE_VALUE;
- hFileError = INVALID_HANDLE_VALUE;
- result = 1;
-
- /*
- * Don't get command line from argc, argv, because the command line
- * tokenizer will have stripped off all the escape sequences needed
- * for quotes and backslashes, and then we'd have to put them all
- * back in again. Get the raw command line and parse off what we
- * want ourselves. The command line should be of the form:
- *
- * stub16.exe program arg1 arg2 ...
- */
-
- cmdLine = strchr(GetCommandLine(), ' ');
- if (cmdLine == NULL) {
- return 1;
- }
- cmdLine++;
-
- hStdInput = GetStdHandle(STD_INPUT_HANDLE);
- hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
- hStdError = GetStdHandle(STD_ERROR_HANDLE);
-
- if (GetFileType(hStdInput) == FILE_TYPE_PIPE) {
- hFileInput = CreateTempFile();
- if (hFileInput == INVALID_HANDLE_VALUE) {
- goto cleanup;
- }
- while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
- if (dwRead == 0) {
- break;
- }
- if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) {
- goto cleanup;
- }
- }
- SetFilePointer(hFileInput, 0, 0, FILE_BEGIN);
- SetStdHandle(STD_INPUT_HANDLE, hFileInput);
- }
- if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) {
- hFileOutput = CreateTempFile();
- if (hFileOutput == INVALID_HANDLE_VALUE) {
- goto cleanup;
- }
- SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput);
- }
- if (GetFileType(hStdError) == FILE_TYPE_PIPE) {
- hFileError = CreateTempFile();
- if (hFileError == INVALID_HANDLE_VALUE) {
- goto cleanup;
- }
- SetStdHandle(STD_ERROR_HANDLE, hFileError);
- }
-
- ZeroMemory(&si, sizeof(si));
- si.cb = sizeof(si);
- if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si,
- &pi) == FALSE) {
- goto cleanup;
- }
-
- WaitForInputIdle(pi.hProcess, 5000);
- WaitForSingleObject(pi.hProcess, INFINITE);
- CloseHandle(pi.hProcess);
- CloseHandle(pi.hThread);
- result = 0;
-
- if (hFileOutput != INVALID_HANDLE_VALUE) {
- SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
- while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
- if (dwRead == 0) {
- break;
- }
- if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) {
- break;
- }
- }
- }
- if (hFileError != INVALID_HANDLE_VALUE) {
- SetFilePointer(hFileError, 0, 0, FILE_BEGIN);
- while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
- if (dwRead == 0) {
- break;
- }
- if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) {
- break;
- }
- }
- }
-
-cleanup:
- if (hFileInput != INVALID_HANDLE_VALUE) {
- CloseHandle(hFileInput);
- }
- if (hFileOutput != INVALID_HANDLE_VALUE) {
- CloseHandle(hFileOutput);
- }
- if (hFileError != INVALID_HANDLE_VALUE) {
- CloseHandle(hFileError);
- }
- CloseHandle(hStdInput);
- CloseHandle(hStdOutput);
- CloseHandle(hStdError);
- ExitProcess(result);
- return 1;
-}
-
-static HANDLE
-CreateTempFile()
-{
- char name[MAX_PATH];
- SECURITY_ATTRIBUTES sa;
-
- if (GetTempPath(sizeof(name), name) == 0) {
- return INVALID_HANDLE_VALUE;
- }
- if (GetTempFileName(name, "tcl", 0, name) == 0) {
- return INVALID_HANDLE_VALUE;
- }
-
- sa.nLength = sizeof(sa);
- sa.lpSecurityDescriptor = NULL;
- sa.bInheritHandle = TRUE;
- return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa,
- CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
- NULL);
-}
diff --git a/win/tcl.rc b/win/tcl.rc
deleted file mode 100644
index f6dab40..0000000
--- a/win/tcl.rc
+++ /dev/null
@@ -1,42 +0,0 @@
-// RCS: @(#) $Id: tcl.rc,v 1.2 1998/09/14 18:40:19 stanton Exp $
-//
-// Version
-//
-
-#define RESOURCE_INCLUDED
-#include <tcl.h>
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- FILEFLAGSMASK 0x3fL
- FILEFLAGS 0x0L
- FILEOS 0x4L
- FILETYPE 0x2L
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0"
- BEGIN
- VALUE "FileDescription", "Tcl DLL\0"
- VALUE "OriginalFilename", "tcl" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0"
- VALUE "CompanyName", "Sun Microsystems, Inc\0"
- VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1997\0"
- VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
- VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
-
-
-
-
-
-
diff --git a/win/tcl16.rc b/win/tcl16.rc
deleted file mode 100644
index 5c44d95..0000000
--- a/win/tcl16.rc
+++ /dev/null
@@ -1,37 +0,0 @@
-// RCS: @(#) $Id: tcl16.rc,v 1.2 1998/09/14 18:40:19 stanton Exp $
-//
-// Version
-//
-
-#define RESOURCE_INCLUDED
-#include <tcl.h>
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- FILEFLAGSMASK 0x3fL
- FILEFLAGS 0x0L
- FILEOS 0x1L
- FILETYPE 0x2L
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0"
- BEGIN
- VALUE "FileDescription", "Tcl16 DLL, 16-bit thunking module\0"
- VALUE "OriginalFilename", "tcl16" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".dll\0"
- VALUE "CompanyName", "Sun Microsystems, Inc\0"
- VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
- VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
- VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
-
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
deleted file mode 100644
index 8eb836f..0000000
--- a/win/tclWinFCmd.c
+++ /dev/null
@@ -1,1401 +0,0 @@
-/*
- * tclWinFCmd.c
- *
- * This file implements the Windows specific portion of file manipulation
- * subcommands of the "file" command.
- *
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinFCmd.c,v 1.2 1998/09/14 18:40:19 stanton Exp $
- */
-
-#include "tclWinInt.h"
-
-/*
- * The following constants specify the type of callback when
- * TraverseWinTree() calls the traverseProc()
- */
-
-#define DOTREE_PRED 1 /* pre-order directory */
-#define DOTREE_POSTD 2 /* post-order directory */
-#define DOTREE_F 3 /* regular file */
-
-/*
- * Callbacks for file attributes code.
- */
-
-static int GetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj **attributePtrPtr));
-static int GetWinFileLongName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj **attributePtrPtr));
-static int GetWinFileShortName _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj **attributePtrPtr));
-static int SetWinFileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj *attributePtr));
-static int CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
- Tcl_Obj *attributePtr));
-
-/*
- * Constants and variables necessary for file attributes subcommand.
- */
-
-enum {
- WIN_ARCHIVE_ATTRIBUTE,
- WIN_HIDDEN_ATTRIBUTE,
- WIN_LONGNAME_ATTRIBUTE,
- WIN_READONLY_ATTRIBUTE,
- WIN_SHORTNAME_ATTRIBUTE,
- WIN_SYSTEM_ATTRIBUTE
-};
-
-static int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
- 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};
-
-
-char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
- "-shortname", "-system", (char *) NULL};
-CONST TclFileAttrProcs tclpFileAttrProcs[] = {
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileLongName, CannotSetAttribute},
- {GetWinFileAttributes, SetWinFileAttributes},
- {GetWinFileShortName, CannotSetAttribute},
- {GetWinFileAttributes, SetWinFileAttributes}};
-
-/*
- * Prototype for the TraverseWinTree callback function.
- */
-
-typedef int (TraversalProc)(char *src, char *dst, DWORD attr, int type,
- Tcl_DString *errorPtr);
-
-/*
- * Declarations for local procedures defined in this file:
- */
-
-static void AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName, int getOrSet));
-static int ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName, int longShort,
- Tcl_Obj **attributePtrPtr));
-static int TraversalCopy(char *src, char *dst, DWORD attr,
- int type, Tcl_DString *errorPtr);
-static int TraversalDelete(char *src, char *dst, DWORD attr,
- int type, Tcl_DString *errorPtr);
-static int TraverseWinTree(TraversalProc *traverseProc,
- Tcl_DString *sourcePtr, Tcl_DString *destPtr,
- Tcl_DString *errorPtr);
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpRenameFile --
- *
- * Changes the name of an existing file or directory, from src to dst.
- * If src and dst refer to the same file or directory, does nothing
- * and returns success. Otherwise if dst already exists, it will be
- * deleted and replaced by src subject to the following conditions:
- * If src is a directory, dst may be an empty directory.
- * If src is a file, dst may be a file.
- * In any other situation where dst already exists, the rename will
- * fail.
- *
- * Results:
- * If the directory was successfully created, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR and errno is set to
- * indicate the error. Some possible values for errno are:
- *
- * EACCES: src or dst parent directory can't be read and/or written.
- * EEXIST: dst is a non-empty directory.
- * EINVAL: src is a root directory or dst is a subdirectory of src.
- * EISDIR: dst is a directory, but src is not.
- * ENOENT: src doesn't exist. src or dst is "".
- * ENOTDIR: src is a directory, but dst is not.
- * EXDEV: src and dst are on different filesystems.
- *
- * EACCES: exists an open file already referring to src or dst.
- * EACCES: src or dst specify the current working directory (NT).
- * EACCES: src specifies a char device (nul:, com1:, etc.)
- * EEXIST: dst specifies a char device (nul:, com1:, etc.) (NT)
- * EACCES: dst specifies a char device (nul:, com1:, etc.) (95)
- *
- * Side effects:
- * The implementation supports cross-filesystem renames of files,
- * but the caller should be prepared to emulate cross-filesystem
- * renames of directories if errno is EXDEV.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpRenameFile(
- char *src, /* Pathname of file or dir to be renamed. */
- char *dst) /* New pathname for file or directory. */
-{
- DWORD srcAttr, dstAttr;
-
- /*
- * Would throw an exception under NT if one of the arguments is a
- * char block device.
- */
-
- try {
- if (MoveFile(src, dst) != FALSE) {
- return TCL_OK;
- }
- } except (-1) {}
-
- TclWinConvertError(GetLastError());
-
- srcAttr = GetFileAttributes(src);
- dstAttr = GetFileAttributes(dst);
- if (srcAttr == (DWORD) -1) {
- srcAttr = 0;
- }
- if (dstAttr == (DWORD) -1) {
- dstAttr = 0;
- }
-
- if (errno == EBADF) {
- errno = EACCES;
- return TCL_ERROR;
- }
- if ((errno == EACCES) && (TclWinGetPlatformId() == VER_PLATFORM_WIN32s)) {
- if ((srcAttr != 0) && (dstAttr != 0)) {
- /*
- * Win32s reports trying to overwrite an existing file or directory
- * as EACCES.
- */
-
- errno = EEXIST;
- }
- }
- if (errno == EACCES) {
- decode:
- if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- char srcPath[MAX_PATH], dstPath[MAX_PATH];
- int srcArgc, dstArgc;
- char **srcArgv, **dstArgv;
- char *srcRest, *dstRest;
- int size;
-
- size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest);
- if ((size == 0) || (size > sizeof(srcPath))) {
- return TCL_ERROR;
- }
- size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest);
- if ((size == 0) || (size > sizeof(dstPath))) {
- return TCL_ERROR;
- }
- if (srcRest == NULL) {
- srcRest = srcPath + strlen(srcPath);
- }
- if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) {
- /*
- * Trying to move a directory into itself.
- */
-
- errno = EINVAL;
- return TCL_ERROR;
- }
- Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
- Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
- if (srcArgc == 1) {
- /*
- * They are trying to move a root directory. Whether
- * or not it is across filesystems, this cannot be
- * done.
- */
-
- errno = EINVAL;
- } else if ((srcArgc > 0) && (dstArgc > 0) &&
- (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
- /*
- * If src is a directory and dst filesystem != src
- * filesystem, errno should be EXDEV. It is very
- * important to get this behavior, so that the caller
- * can respond to a cross filesystem rename by
- * simulating it with copy and delete. The MoveFile
- * system call already handles the case of moving a
- * file between filesystems.
- */
-
- errno = EXDEV;
- }
-
- ckfree((char *) srcArgv);
- ckfree((char *) dstArgv);
- }
-
- /*
- * Other types of access failure is that dst is a read-only
- * filesystem, that an open file referred to src or dest, or that
- * src or dest specified the current working directory on the
- * current filesystem. EACCES is returned for those cases.
- */
-
- } else if (errno == EEXIST) {
- /*
- * Reports EEXIST any time the target already exists. If it makes
- * sense, remove the old file and try renaming again.
- */
-
- if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
- if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Overwrite empty dst directory with src directory. The
- * following call will remove an empty directory. If it
- * fails, it's because it wasn't empty.
- */
-
- if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
- /*
- * Now that that empty directory is gone, we can try
- * renaming again. If that fails, we'll put this empty
- * directory back, for completeness.
- */
-
- if (MoveFile(src, dst) != FALSE) {
- return TCL_OK;
- }
-
- /*
- * Some new error has occurred. Don't know what it
- * could be, but report this one.
- */
-
- TclWinConvertError(GetLastError());
- CreateDirectory(dst, NULL);
- SetFileAttributes(dst, dstAttr);
- if (errno == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
-
- goto decode;
- }
- }
- } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- errno = ENOTDIR;
- }
- } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */
- if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) {
- errno = EISDIR;
- } else {
- /*
- * Overwrite existing file by:
- *
- * 1. Rename existing file to temp name.
- * 2. Rename old file to new name.
- * 3. If success, delete temp file. If failure,
- * put temp file back to old name.
- */
-
- char tempName[MAX_PATH];
- int result, size;
- char *rest;
-
- size = GetFullPathName(dst, sizeof(tempName), tempName, &rest);
- if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) {
- return TCL_ERROR;
- }
- *rest = '\0';
- result = TCL_ERROR;
- if (GetTempFileName(tempName, "tclr", 0, tempName) != 0) {
- /*
- * Strictly speaking, need the following DeleteFile and
- * MoveFile to be joined as an atomic operation so no
- * other app comes along in the meantime and creates the
- * same temp file.
- */
-
- DeleteFile(tempName);
- if (MoveFile(dst, tempName) != FALSE) {
- if (MoveFile(src, dst) != FALSE) {
- SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL);
- DeleteFile(tempName);
- return TCL_OK;
- } else {
- DeleteFile(dst);
- MoveFile(tempName, dst);
- }
- }
-
- /*
- * Can't backup dst file or move src file. Return that
- * error. Could happen if an open file refers to dst.
- */
-
- TclWinConvertError(GetLastError());
- if (errno == EACCES) {
- /*
- * Decode the EACCES to a more meaningful error.
- */
-
- goto decode;
- }
- }
- return result;
- }
- }
- }
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpCopyFile --
- *
- * Copy a single file (not a directory). If dst already exists and
- * is not a directory, it is removed.
- *
- * Results:
- * If the file was successfully copied, returns TCL_OK. Otherwise
- * the return value is TCL_ERROR and errno is set to indicate the
- * error. Some possible values for errno are:
- *
- * EACCES: src or dst parent directory can't be read and/or written.
- * EISDIR: src or dst is a directory.
- * ENOENT: src doesn't exist. src or dst is "".
- *
- * EACCES: exists an open file already referring to dst (95).
- * EACCES: src specifies a char device (nul:, com1:, etc.) (NT)
- * ENOENT: src specifies a char device (nul:, com1:, etc.) (95)
- *
- * Side effects:
- * It is not an error to copy to a char device.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpCopyFile(
- char *src, /* Pathname of file to be copied. */
- char *dst) /* Pathname of file to copy to. */
-{
- /*
- * Would throw an exception under NT if one of the arguments is a char
- * block device.
- */
-
- try {
- if (CopyFile(src, dst, 0) != FALSE) {
- return TCL_OK;
- }
- } except (-1) {}
-
- TclWinConvertError(GetLastError());
- if (errno == EBADF) {
- errno = EACCES;
- return TCL_ERROR;
- }
- if (errno == EACCES) {
- DWORD srcAttr, dstAttr;
-
- srcAttr = GetFileAttributes(src);
- dstAttr = GetFileAttributes(dst);
- if (srcAttr != (DWORD) -1) {
- if (dstAttr == (DWORD) -1) {
- dstAttr = 0;
- }
- if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
- (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
- errno = EISDIR;
- }
- if (dstAttr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(dst, dstAttr & ~FILE_ATTRIBUTE_READONLY);
- if (CopyFile(src, dst, 0) != FALSE) {
- return TCL_OK;
- }
- /*
- * Still can't copy onto dst. Return that error, and
- * restore attributes of dst.
- */
-
- TclWinConvertError(GetLastError());
- SetFileAttributes(dst, dstAttr);
- }
- }
- }
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpDeleteFile --
- *
- * Removes a single file (not a directory).
- *
- * Results:
- * If the file was successfully deleted, returns TCL_OK. Otherwise
- * the return value is TCL_ERROR and errno is set to indicate the
- * error. Some possible values for errno are:
- *
- * EACCES: a parent directory can't be read and/or written.
- * EISDIR: path is a directory.
- * ENOENT: path doesn't exist or is "".
- *
- * EACCES: exists an open file already referring to path.
- * EACCES: path is a char device (nul:, com1:, etc.)
- *
- * Side effects:
- * The file is deleted, even if it is read-only.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpDeleteFile(
- char *path) /* Pathname of file to be removed. */
-{
- DWORD attr;
-
- if (DeleteFile(path) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- if (path[0] == '\0') {
- /*
- * Win32s thinks that "" is the same as "." and then reports EISDIR
- * instead of ENOENT.
- */
-
- errno = ENOENT;
- } else if (errno == EACCES) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows NT reports removing a directory as EACCES instead
- * of EISDIR.
- */
-
- errno = EISDIR;
- } else if (attr & FILE_ATTRIBUTE_READONLY) {
- SetFileAttributes(path, attr & ~FILE_ATTRIBUTE_READONLY);
- if (DeleteFile(path) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- SetFileAttributes(path, attr);
- }
- }
- } else if (errno == ENOENT) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
- if (attr & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Windows 95 reports removing a directory as ENOENT instead
- * of EISDIR.
- */
-
- errno = EISDIR;
- }
- }
- } else if (errno == EINVAL) {
- /*
- * Windows NT reports removing a char device as EINVAL instead of
- * EACCES.
- */
-
- errno = EACCES;
- }
-
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpCreateDirectory --
- *
- * Creates the specified directory. All parent directories of the
- * specified directory must already exist. The directory is
- * automatically created with permissions so that user can access
- * the new directory and create new files or subdirectories in it.
- *
- * Results:
- * If the directory was successfully created, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR and errno is set to
- * indicate the error. Some possible values for errno are:
- *
- * EACCES: a parent directory can't be read and/or written.
- * EEXIST: path already exists.
- * ENOENT: a parent directory doesn't exist.
- *
- * Side effects:
- * A directory is created.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpCreateDirectory(
- char *path) /* Pathname of directory to create */
-{
- int error;
-
- if (CreateDirectory(path, NULL) == 0) {
- error = GetLastError();
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32s) {
- if ((error == ERROR_ACCESS_DENIED)
- && (GetFileAttributes(path) != (DWORD) -1)) {
- error = ERROR_FILE_EXISTS;
- }
- }
- TclWinConvertError(error);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpCopyDirectory --
- *
- * Recursively copies a directory. The target directory dst must
- * not already exist. Note that this function does not merge two
- * directory hierarchies, even if the target directory is an an
- * empty directory.
- *
- * Results:
- * If the directory was successfully copied, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR, errno is set to indicate
- * the error, and the pathname of the file that caused the error
- * is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
- * for a description of possible values for errno.
- *
- * Side effects:
- * An exact copy of the directory hierarchy src will be created
- * with the name dst. If an error occurs, the error will
- * be returned immediately, and remaining files will not be
- * processed.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpCopyDirectory(
- char *src, /* Pathname of directory to be copied. */
- char *dst, /* Pathname of target directory. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
-{
- int result;
- Tcl_DString srcBuffer;
- Tcl_DString dstBuffer;
-
- Tcl_DStringInit(&srcBuffer);
- Tcl_DStringInit(&dstBuffer);
- Tcl_DStringAppend(&srcBuffer, src, -1);
- Tcl_DStringAppend(&dstBuffer, dst, -1);
- result = TraverseWinTree(TraversalCopy, &srcBuffer, &dstBuffer,
- errorPtr);
- Tcl_DStringFree(&srcBuffer);
- Tcl_DStringFree(&dstBuffer);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpRemoveDirectory --
- *
- * Removes directory (and its contents, if the recursive flag is set).
- *
- * Results:
- * If the directory was successfully removed, returns TCL_OK.
- * Otherwise the return value is TCL_ERROR, errno is set to indicate
- * the error, and the pathname of the file that caused the error
- * is stored in errorPtr. Some possible values for errno are:
- *
- * EACCES: path directory can't be read and/or written.
- * EEXIST: path is a non-empty directory.
- * EINVAL: path is root directory or current directory.
- * ENOENT: path doesn't exist or is "".
- * ENOTDIR: path is not a directory.
- *
- * EACCES: path is a char device (nul:, com1:, etc.) (95)
- * EINVAL: path is a char device (nul:, com1:, etc.) (NT)
- *
- * Side effects:
- * Directory removed. If an error occurs, the error will be returned
- * immediately, and remaining files will not be deleted.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpRemoveDirectory(
- char *path, /* Pathname of directory to be removed. */
- int recursive, /* If non-zero, removes directories that
- * are nonempty. Otherwise, will only remove
- * empty directories. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
-{
- int result;
- Tcl_DString buffer;
- DWORD attr;
-
- if (RemoveDirectory(path) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- if (path[0] == '\0') {
- /*
- * Win32s thinks that "" is the same as "." and then reports EACCES
- * instead of ENOENT.
- */
-
- errno = ENOENT;
- }
- if (errno == EACCES) {
- attr = GetFileAttributes(path);
- if (attr != (DWORD) -1) {
- if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * Windows 95 reports calling RemoveDirectory on a file as an
- * EACCES, not an ENOTDIR.
- */
-
- errno = ENOTDIR;
- goto end;
- }
-
- if (attr & FILE_ATTRIBUTE_READONLY) {
- attr &= ~FILE_ATTRIBUTE_READONLY;
- if (SetFileAttributes(path, attr) == FALSE) {
- goto end;
- }
- if (RemoveDirectory(path) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- SetFileAttributes(path, attr | FILE_ATTRIBUTE_READONLY);
- }
-
- /*
- * Windows 95 and Win32s report removing a non-empty directory
- * as EACCES, not EEXIST. If the directory is not empty,
- * change errno so caller knows what's going on.
- */
-
- if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
- HANDLE handle;
- WIN32_FIND_DATA data;
- Tcl_DString buffer;
- char *find;
- int len;
-
- Tcl_DStringInit(&buffer);
- find = Tcl_DStringAppend(&buffer, path, -1);
- len = Tcl_DStringLength(&buffer);
- if ((len > 0) && (find[len - 1] != '\\')) {
- Tcl_DStringAppend(&buffer, "\\", 1);
- }
- find = Tcl_DStringAppend(&buffer, "*.*", 3);
- handle = FindFirstFile(find, &data);
- if (handle != INVALID_HANDLE_VALUE) {
- while (1) {
- if ((strcmp(data.cFileName, ".") != 0)
- && (strcmp(data.cFileName, "..") != 0)) {
- /*
- * Found something in this directory.
- */
-
- errno = EEXIST;
- break;
- }
- if (FindNextFile(handle, &data) == FALSE) {
- break;
- }
- }
- FindClose(handle);
- }
- Tcl_DStringFree(&buffer);
- }
- }
- }
- if (errno == ENOTEMPTY) {
- /*
- * The caller depends on EEXIST to signify that the directory is
- * not empty, not ENOTEMPTY.
- */
-
- errno = EEXIST;
- }
- if ((recursive != 0) && (errno == EEXIST)) {
- /*
- * The directory is nonempty, but the recursive flag has been
- * specified, so we recursively remove all the files in the directory.
- */
-
- Tcl_DStringInit(&buffer);
- Tcl_DStringAppend(&buffer, path, -1);
- result = TraverseWinTree(TraversalDelete, &buffer, NULL, errorPtr);
- Tcl_DStringFree(&buffer);
- return result;
- }
-
- end:
- if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, path, -1);
- }
- return TCL_ERROR;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TraverseWinTree --
- *
- * Traverse directory tree specified by sourcePtr, calling the function
- * traverseProc for each file and directory encountered. If destPtr
- * is non-null, each of name in the sourcePtr directory is appended to
- * the directory specified by destPtr and passed as the second argument
- * to traverseProc() .
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * None caused by TraverseWinTree, however the user specified
- * traverseProc() may change state. If an error occurs, the error will
- * be returned immediately, and remaining files will not be processed.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-TraverseWinTree(
- TraversalProc *traverseProc,/* Function to call for every file and
- * directory in source hierarchy. */
- Tcl_DString *sourcePtr, /* Pathname of source directory to be
- * traversed. */
- Tcl_DString *targetPtr, /* Pathname of directory to traverse in
- * parallel with source directory. */
- Tcl_DString *errorPtr) /* If non-NULL, an initialized DString for
- * error reporting. */
-{
- DWORD sourceAttr;
- char *source, *target, *errfile;
- int result, sourceLen, targetLen, sourceLenOriginal, targetLenOriginal;
- HANDLE handle;
- WIN32_FIND_DATA data;
-
- result = TCL_OK;
- source = Tcl_DStringValue(sourcePtr);
- sourceLenOriginal = Tcl_DStringLength(sourcePtr);
- if (targetPtr != NULL) {
- target = Tcl_DStringValue(targetPtr);
- targetLenOriginal = Tcl_DStringLength(targetPtr);
- } else {
- target = NULL;
- targetLenOriginal = 0;
- }
-
- errfile = NULL;
-
- sourceAttr = GetFileAttributes(source);
- if (sourceAttr == (DWORD) -1) {
- errfile = source;
- goto end;
- }
- if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
- /*
- * Process the regular file
- */
-
- return (*traverseProc)(source, target, sourceAttr, DOTREE_F, errorPtr);
- }
-
- /*
- * When given the pathname of the form "c:\" (one that already ends
- * with a backslash), must make sure not to add another "\" to the end
- * otherwise it will try to access a network drive.
- */
-
- sourceLen = sourceLenOriginal;
- if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
- Tcl_DStringAppend(sourcePtr, "\\", 1);
- sourceLen++;
- }
- source = Tcl_DStringAppend(sourcePtr, "*.*", 3);
- handle = FindFirstFile(source, &data);
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (handle == INVALID_HANDLE_VALUE) {
- /*
- * Can't read directory
- */
-
- TclWinConvertError(GetLastError());
- errfile = source;
- goto end;
- }
-
- result = (*traverseProc)(source, target, sourceAttr, DOTREE_PRED, errorPtr);
- if (result != TCL_OK) {
- FindClose(handle);
- return result;
- }
-
- if (targetPtr != NULL) {
- targetLen = targetLenOriginal;
- if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
- target = Tcl_DStringAppend(targetPtr, "\\", 1);
- targetLen++;
- }
- }
-
- while (1) {
- if ((strcmp(data.cFileName, ".") != 0)
- && (strcmp(data.cFileName, "..") != 0)) {
- /*
- * Append name after slash, and recurse on the file.
- */
-
- Tcl_DStringAppend(sourcePtr, data.cFileName, -1);
- if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, data.cFileName, -1);
- }
- result = TraverseWinTree(traverseProc, sourcePtr, targetPtr,
- errorPtr);
- if (result != TCL_OK) {
- break;
- }
-
- /*
- * Remove name after slash.
- */
-
- Tcl_DStringSetLength(sourcePtr, sourceLen);
- if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, targetLen);
- }
- }
- if (FindNextFile(handle, &data) == FALSE) {
- break;
- }
- }
- FindClose(handle);
-
- /*
- * Strip off the trailing slash we added
- */
-
- Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
- source = Tcl_DStringValue(sourcePtr);
- if (targetPtr != NULL) {
- Tcl_DStringSetLength(targetPtr, targetLenOriginal);
- target = Tcl_DStringValue(targetPtr);
- }
-
- if (result == TCL_OK) {
- /*
- * Call traverseProc() on a directory after visiting all the
- * files in that directory.
- */
-
- result = (*traverseProc)(source, target, sourceAttr,
- DOTREE_POSTD, errorPtr);
- }
- end:
- if (errfile != NULL) {
- TclWinConvertError(GetLastError());
- if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, errfile, -1);
- }
- result = TCL_ERROR;
- }
-
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TraversalCopy
- *
- * Called from TraverseUnixTree in order to execute a recursive
- * copy of a directory.
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * Depending on the value of type, src may be copied to dst.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TraversalCopy(
- char *src, /* Source pathname to copy. */
- char *dst, /* Destination pathname of copy. */
- DWORD srcAttr, /* File attributes for src. */
- int type, /* Reason for call - see TraverseWinTree() */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error return. */
-{
- switch (type) {
- case DOTREE_F:
- if (TclpCopyFile(src, dst) == TCL_OK) {
- return TCL_OK;
- }
- break;
-
- case DOTREE_PRED:
- if (TclpCreateDirectory(dst) == TCL_OK) {
- if (SetFileAttributes(dst, srcAttr) != FALSE) {
- return TCL_OK;
- }
- TclWinConvertError(GetLastError());
- }
- break;
-
- case DOTREE_POSTD:
- return TCL_OK;
-
- }
-
- /*
- * There shouldn't be a problem with src, because we already
- * checked it to get here.
- */
-
- if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, dst, -1);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TraversalDelete --
- *
- * Called by procedure TraverseWinTree for every file and
- * directory that it encounters in a directory hierarchy. This
- * procedure unlinks files, and removes directories after all the
- * containing files have been processed.
- *
- * Results:
- * Standard Tcl result.
- *
- * Side effects:
- * Files or directory specified by src will be deleted. If an
- * error occurs, the windows error is converted to a Posix error
- * and errno is set accordingly.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TraversalDelete(
- char *src, /* Source pathname. */
- char *ignore, /* Destination pathname (not used). */
- DWORD srcAttr, /* File attributes for src (not used). */
- int type, /* Reason for call - see TraverseWinTree(). */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error return. */
-{
- switch (type) {
- case DOTREE_F:
- if (TclpDeleteFile(src) == TCL_OK) {
- return TCL_OK;
- }
- break;
-
- case DOTREE_PRED:
- return TCL_OK;
-
- case DOTREE_POSTD:
- if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
- return TCL_OK;
- }
- break;
-
- }
-
- if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, src, -1);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AttributesPosixError --
- *
- * Sets the object result with the appropriate error.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The interp's object result is set with an error message
- * based on the objIndex, fileName and errno.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AttributesPosixError(
- Tcl_Interp *interp, /* The interp that has the error */
- int objIndex, /* The attribute which caused the problem. */
- char *fileName, /* The name of the file which caused the
- * error. */
- int getOrSet) /* 0 for get; 1 for set */
-{
- TclWinConvertError(GetLastError());
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot ", getOrSet ? "set" : "get", " attribute \"",
- tclpFileAttrStrings[objIndex], "\" for file \"", fileName,
- "\": ", Tcl_PosixError(interp), (char *) NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileAttributes --
- *
- * Returns a Tcl_Obj containing the value of a file attribute.
- * This routine gets the -hidden, -readonly or -system attribute.
- *
- * Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetWinFileAttributes(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
-{
- DWORD result = GetFileAttributes(fileName);
-
- if (result == 0xFFFFFFFF) {
- AttributesPosixError(interp, objIndex, fileName, 0);
- return TCL_ERROR;
- }
-
- *attributePtrPtr = Tcl_NewBooleanObj(result & attributeArray[objIndex]);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertFileNameFormat --
- *
- * Returns a Tcl_Obj containing either the long or short version of the
- * file name.
- *
- * Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ConvertFileNameFormat(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- int longShort, /* 0 to short name, 1 to long name. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
-{
- HANDLE findHandle;
- WIN32_FIND_DATA findData;
- int pathArgc, i;
- char **pathArgv, **newPathArgv;
- char *currentElement, *resultStr;
- Tcl_DString resultDString;
- int result = TCL_OK;
-
- Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
- newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
-
- i = 0;
- if ((pathArgv[0][0] == '/')
- || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
- newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
- strcpy(newPathArgv[0], pathArgv[0]);
- i = 1;
- }
- for ( ; i < pathArgc; i++) {
- if (strcmp(pathArgv[i], ".") == 0) {
- currentElement = ckalloc(2);
- strcpy(currentElement, ".");
- } else if (strcmp(pathArgv[i], "..") == 0) {
- currentElement = ckalloc(3);
- strcpy(currentElement, "..");
- } else {
- int useLong;
-
- Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
- findHandle = FindFirstFile(resultStr, &findData);
- if (findHandle == INVALID_HANDLE_VALUE) {
- pathArgc = i - 1;
- AttributesPosixError(interp, objIndex, fileName, 0);
- result = TCL_ERROR;
- Tcl_DStringFree(&resultDString);
- goto cleanup;
- }
- if (longShort) {
- if (findData.cFileName[0] != '\0') {
- useLong = 1;
- } else {
- useLong = 0;
- }
- } else {
- if (findData.cAlternateFileName[0] == '\0') {
- useLong = 1;
- } else {
- useLong = 0;
- }
- }
- if (useLong) {
- currentElement = ckalloc(strlen(findData.cFileName) + 1);
- strcpy(currentElement, findData.cFileName);
- } else {
- currentElement = ckalloc(strlen(findData.cAlternateFileName)
- + 1);
- strcpy(currentElement, findData.cAlternateFileName);
- }
- Tcl_DStringFree(&resultDString);
- FindClose(findHandle);
- }
- newPathArgv[i] = currentElement;
- }
-
- Tcl_DStringInit(&resultDString);
- resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
- *attributePtrPtr = Tcl_NewStringObj(resultStr, Tcl_DStringLength(&resultDString));
- Tcl_DStringFree(&resultDString);
-
-cleanup:
- for (i = 0; i < pathArgc; i++) {
- ckfree(newPathArgv[i]);
- }
- ckfree((char *) newPathArgv);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileLongName --
- *
- * Returns a Tcl_Obj containing the short version of the file
- * name.
- *
- * Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetWinFileLongName(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
-{
- return ConvertFileNameFormat(interp, objIndex, fileName, 1, attributePtrPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetWinFileShortName --
- *
- * Returns a Tcl_Obj containing the short version of the file
- * name.
- *
- * Results:
- * Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
- * will have ref count 0. If the return value is not TCL_OK,
- * attributePtrPtr is not touched.
- *
- * Side effects:
- * A new object is allocated if the file is valid.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetWinFileShortName(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
-{
- return ConvertFileNameFormat(interp, objIndex, fileName, 0, attributePtrPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWinFileAttributes --
- *
- * Set the file attributes to the value given by attributePtr.
- * This routine sets the -hidden, -readonly, or -system attributes.
- *
- * Results:
- * Standard TCL error.
- *
- * Side effects:
- * The file's attribute is set.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetWinFileAttributes(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj *attributePtr) /* The new value of the attribute. */
-{
- DWORD fileAttributes = GetFileAttributes(fileName);
- int yesNo;
- int result;
-
- if (fileAttributes == 0xFFFFFFFF) {
- AttributesPosixError(interp, objIndex, fileName, 1);
- return TCL_ERROR;
- }
-
- result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
- if (result != TCL_OK) {
- return result;
- }
-
- if (yesNo) {
- fileAttributes |= (attributeArray[objIndex]);
- } else {
- fileAttributes &= ~(attributeArray[objIndex]);
- }
-
- if (!SetFileAttributes(fileName, fileAttributes)) {
- AttributesPosixError(interp, objIndex, fileName, 1);
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWinFileLongName --
- *
- * The attribute in question is a readonly attribute and cannot
- * be set.
- *
- * Results:
- * TCL_ERROR
- *
- * Side effects:
- * The object result is set to a pertinant error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CannotSetAttribute(
- Tcl_Interp *interp, /* The interp we are using for errors. */
- int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
- Tcl_Obj *attributePtr) /* The new value of the attribute. */
-{
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "cannot set attribute \"", tclpFileAttrStrings[objIndex],
- "\" for file \"", fileName, "\" : attribute is readonly",
- (char *) NULL);
- return TCL_ERROR;
-}
-
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpListVolumes --
- *
- * Lists the currently mounted volumes
- *
- * Results:
- * A standard Tcl result. Will always be TCL_OK, since there is no way
- * that this command can fail. Also, the interpreter's result is set to
- * the list of volumes.
- *
- * Side effects:
- * None
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpListVolumes(
- Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
-{
- Tcl_Obj *resultPtr, *elemPtr;
- char buf[4];
- int i;
-
- resultPtr = Tcl_GetObjResult(interp);
-
- buf[1] = ':';
- buf[2] = '/';
- buf[3] = '\0';
-
- /*
- * On Win32s:
- * GetLogicalDriveStrings() isn't implemented.
- * GetLogicalDrives() returns incorrect information.
- */
-
- for (i = 0; i < 26; i++) {
- buf[0] = (char) ('a' + i);
- if (GetVolumeInformation(buf, NULL, 0, NULL, NULL, NULL, NULL, 0)
- || (GetLastError() == ERROR_NOT_READY)) {
- elemPtr = Tcl_NewStringObj(buf, -1);
- Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
- }
- }
- return TCL_OK;
-}
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
deleted file mode 100644
index 4f0f26d..0000000
--- a/win/tclWinFile.c
+++ /dev/null
@@ -1,647 +0,0 @@
-/*
- * tclWinFile.c --
- *
- * This file contains temporary wrappers around UNIX file handling
- * functions. These wrappers map the UNIX functions to Win32 HANDLE-style
- * files, which can be manipulated through the Win32 console redirection
- * interfaces.
- *
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclWinFile.c,v 1.3 1998/09/14 18:40:20 stanton Exp $
- */
-
-#include "tclWinInt.h"
-#include <sys/stat.h>
-#include <shlobj.h>
-
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
-
-static char *currentDir = NULL;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindExecutable --
- *
- * This procedure computes the absolute path name of the current
- * application, given its argv[0] value.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The variable tclExecutableName gets filled in with the file
- * name for the application, if we figured it out. If we couldn't
- * figure it out, Tcl_FindExecutable is set to NULL.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_FindExecutable(argv0)
- char *argv0; /* The value of the application's argv[0]. */
-{
- Tcl_DString buffer;
- int length;
-
- Tcl_DStringInit(&buffer);
-
- if (tclExecutableName != NULL) {
- ckfree(tclExecutableName);
- tclExecutableName = NULL;
- }
-
- /*
- * Under Windows we ignore argv0, and return the path for the file used to
- * create this process.
- */
-
- Tcl_DStringSetLength(&buffer, MAX_PATH+1);
- length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
- if (length > 0) {
- tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
- strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
- }
- Tcl_DStringFree(&buffer);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclMatchFiles --
- *
- * This routine is used by the globbing code to search a
- * directory for all files which match a given pattern.
- *
- * Results:
- * If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
- * recursively for each matching subdirectory. The return value
- * is a standard Tcl result indicating whether an error occurred
- * in globbing.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------- */
-
-int
-TclMatchFiles(interp, separators, dirPtr, pattern, tail)
- Tcl_Interp *interp; /* Interpreter to receive results. */
- char *separators; /* Directory separators to pass to TclDoGlob. */
- Tcl_DString *dirPtr; /* Contains path to directory to search. */
- char *pattern; /* Pattern to match against. */
- char *tail; /* Pointer to end of pattern. Tail must
- * point to a location in pattern. */
-{
- char drivePattern[4] = "?:\\";
- char *newPattern, *p, *dir, *root, c;
- char *src, *dest;
- int length, matchDotFiles;
- int result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- Tcl_DString buffer;
- DWORD atts, volFlags;
- HANDLE handle;
- WIN32_FIND_DATA data;
- BOOL found;
-
- /*
- * Convert the path to normalized form since some interfaces only
- * accept backslashes. Also, ensure that the directory ends with a
- * separator character.
- */
-
- Tcl_DStringInit(&buffer);
- if (baseLength == 0) {
- Tcl_DStringAppend(&buffer, ".", 1);
- } else {
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
- Tcl_DStringLength(dirPtr));
- }
- for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
- }
- }
- p--;
- if (*p != '\\' && *p != ':') {
- Tcl_DStringAppend(&buffer, "\\", 1);
- }
- dir = Tcl_DStringValue(&buffer);
-
- /*
- * First verify that the specified path is actually a directory.
- */
-
- atts = GetFileAttributes(dir);
- if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&buffer);
- return TCL_OK;
- }
-
- /*
- * Next check the volume information for the directory to see whether
- * comparisons should be case sensitive or not. If the root is null, then
- * we use the root of the current directory. If the root is just a drive
- * specifier, we use the root directory of the given drive.
- */
-
- switch (Tcl_GetPathType(dir)) {
- case TCL_PATH_RELATIVE:
- found = GetVolumeInformation(NULL, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- break;
- case TCL_PATH_VOLUME_RELATIVE:
- if (*dir == '\\') {
- root = NULL;
- } else {
- root = drivePattern;
- *root = *dir;
- }
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- break;
- case TCL_PATH_ABSOLUTE:
- if (dir[1] == ':') {
- root = drivePattern;
- *root = *dir;
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- } else if (dir[1] == '\\') {
- p = strchr(dir+2, '\\');
- p = strchr(p+1, '\\');
- p++;
- c = *p;
- *p = 0;
- found = GetVolumeInformation(dir, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- *p = c;
- }
- break;
- }
-
- if (!found) {
- Tcl_DStringFree(&buffer);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read volume information for \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * In Windows, although some volumes may support case sensitivity, Windows
- * doesn't honor case. So in globbing we need to ignore the case
- * of file names.
- */
-
- length = tail - pattern;
- newPattern = ckalloc(length+1);
- for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
- *dest = (char) tolower(*src);
- }
- *dest = '\0';
-
- /*
- * We need to check all files in the directory, so append a *.*
- * to the path.
- */
-
-
- dir = Tcl_DStringAppend(&buffer, "*.*", 3);
-
- /*
- * Now open the directory for reading and iterate over the contents.
- */
-
- handle = FindFirstFile(dir, &data);
- Tcl_DStringFree(&buffer);
-
- if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- ckfree(newPattern);
- return TCL_ERROR;
- }
-
- /*
- * Clean up the tail pointer. Leave the tail pointing to the
- * first character after the path separator or NULL.
- */
-
- if (*tail == '\\') {
- tail++;
- }
- if (*tail == '\0') {
- tail = NULL;
- } else {
- tail++;
- }
-
- /*
- * Check to see if the pattern needs to compare with dot files.
- */
-
- if ((newPattern[0] == '.')
- || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
- matchDotFiles = 1;
- } else {
- matchDotFiles = 0;
- }
-
- /*
- * Now iterate over all of the files in the directory.
- */
-
- Tcl_DStringInit(&buffer);
- for (found = 1; found; found = FindNextFile(handle, &data)) {
- char *matchResult;
-
- /*
- * Ignore hidden files.
- */
-
- if (!matchDotFiles && (data.cFileName[0] == '.')) {
- continue;
- }
-
- /*
- * Check to see if the file matches the pattern. We need to convert
- * the file name to lower case for comparison purposes. Note that we
- * are ignoring the case sensitivity flag because Windows doesn't honor
- * case even if the volume is case sensitive. If the volume also
- * doesn't preserve case, then we return the lower case form of the
- * name, otherwise we return the system form.
- */
-
- matchResult = NULL;
- Tcl_DStringSetLength(&buffer, 0);
- Tcl_DStringAppend(&buffer, data.cFileName, -1);
- for (p = buffer.string; *p != '\0'; p++) {
- *p = (char) tolower(*p);
- }
- if (Tcl_StringMatch(buffer.string, newPattern)) {
- if (volFlags & FS_CASE_IS_PRESERVED) {
- matchResult = data.cFileName;
- } else {
- matchResult = buffer.string;
- }
- }
-
- if (matchResult == NULL) {
- continue;
- }
-
- /*
- * If the file matches, then we need to process the remainder of the
- * path. If there are more characters to process, then ensure matching
- * files are directories and call TclDoGlob. Otherwise, just add the
- * file to the result.
- */
-
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, matchResult, -1);
- if (tail == NULL) {
- Tcl_AppendElement(interp, dirPtr->string);
- } else {
- atts = GetFileAttributes(dirPtr->string);
- if (atts & FILE_ATTRIBUTE_DIRECTORY) {
- Tcl_DStringAppend(dirPtr, "/", 1);
- result = TclDoGlob(interp, separators, dirPtr, tail);
- if (result != TCL_OK) {
- break;
- }
- }
- }
- }
-
- Tcl_DStringFree(&buffer);
- FindClose(handle);
- ckfree(newPattern);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChdir --
- *
- * Change the current working directory.
- *
- * Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
- *
- * Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclChdir(interp, dirName)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
- char *dirName; /* Path to new working directory. */
-{
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
- }
- if (!SetCurrentDirectory(dirName)) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
- }
- return TCL_ERROR;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetCwd --
- *
- * Return the path name of the current working directory.
- *
- * Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it
- * out. If an error occurs and interp isn't NULL, an error
- * message is left in interp->result.
- *
- * Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetCwd(interp)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
-{
- static char buffer[MAXPATHLEN+1];
- char *bufPtr, *p;
-
- if (currentDir == NULL) {
- if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- if (errno == ERANGE) {
- Tcl_SetResult(interp,
- "working directory name is too long",
- TCL_STATIC);
- } else {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- }
- return NULL;
- }
- /*
- * Watch for the wierd Windows '95 c:\\UNC syntax.
- */
-
- if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
- && buffer[3] == '\\') {
- bufPtr = &buffer[2];
- } else {
- bufPtr = buffer;
- }
-
- /*
- * Convert to forward slashes for easier use in scripts.
- */
-
- for (p = bufPtr; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
- }
- }
- }
- return bufPtr;
-}
-
-#if 0
-/*
- *-------------------------------------------------------------------------
- *
- * TclWinResolveShortcut --
- *
- * Resolve a potential Windows shortcut to get the actual file or
- * directory in question.
- *
- * Results:
- * Returns 1 if the shortcut could be resolved, or 0 if there was
- * an error or if the filename was not a shortcut.
- * If bufferPtr did hold the name of a shortcut, it is modified to
- * hold the resolved target of the shortcut instead.
- *
- * Side effects:
- * Loads and unloads OLE package to determine if filename refers to
- * a shortcut.
- *
- *-------------------------------------------------------------------------
- */
-
-int
-TclWinResolveShortcut(bufferPtr)
- Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
- * return, holds resolved file name. */
-{
- HRESULT hres;
- IShellLink *psl;
- IPersistFile *ppf;
- WIN32_FIND_DATA wfd;
- WCHAR wpath[MAX_PATH];
- char *path, *ext;
- char realFileName[MAX_PATH];
-
- /*
- * Windows system calls do not automatically resolve
- * shortcuts like UNIX automatically will with symbolic links.
- */
-
- path = Tcl_DStringValue(bufferPtr);
- ext = strrchr(path, '.');
- if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
- return 0;
- }
-
- CoInitialize(NULL);
- path = Tcl_DStringValue(bufferPtr);
- realFileName[0] = '\0';
- hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
- &IID_IShellLink, &psl);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
- if (SUCCEEDED(hres)) {
- MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
- hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->Resolve(psl, NULL,
- SLR_ANY_MATCH | SLR_NO_UI);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
- &wfd, 0);
- }
- }
- ppf->lpVtbl->Release(ppf);
- }
- psl->lpVtbl->Release(psl);
- }
- CoUninitialize();
-
- if (realFileName[0] != '\0') {
- Tcl_DStringSetLength(bufferPtr, 0);
- Tcl_DStringAppend(bufferPtr, realFileName, -1);
- return 1;
- }
- return 0;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpStat, TclpLstat --
- *
- * These functions replace the library versions of stat and lstat.
- *
- * The stat and lstat functions provided by some Windows compilers
- * are incomplete. Ideally, a complete rewrite of stat would go
- * here; now, the only fix is that stat("c:") used to return an
- * error instead infor for current dir on specified drive.
- *
- * Results:
- * See stat documentation.
- *
- * Side effects:
- * See stat documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpStat(path, buf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *buf; /* Filled with results of stat call. */
-{
- char name[4];
- int result;
-
- if ((strlen(path) == 2) && (path[1] == ':')) {
- strcpy(name, path);
- name[2] = '.';
- name[3] = '\0';
- path = name;
- }
-
-#undef stat
-
- result = stat(path, buf);
-
-#ifndef _MSC_VER
-
- /*
- * Borland's stat doesn't take into account localtime.
- */
-
- if ((result == 0) && (buf->st_mtime != 0)) {
- TIME_ZONE_INFORMATION tz;
- int time, bias;
-
- time = GetTimeZoneInformation(&tz);
- bias = tz.Bias;
- if (time == TIME_ZONE_ID_DAYLIGHT) {
- bias += tz.DaylightBias;
- }
- bias *= 60;
- buf->st_atime -= bias;
- buf->st_ctime -= bias;
- buf->st_mtime -= bias;
- }
-
-#endif
-
- return result;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclpAccess --
- *
- * This function replaces the library version of access.
- *
- * The library version of access returns that all files have execute
- * permission.
- *
- * Results:
- * See access documentation.
- *
- * Side effects:
- * See access documentation.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclpAccess(
- CONST char *path, /* Path of file to access (in current CP). */
- int mode) /* Permission setting. */
-{
- int result;
- CONST char *p;
-
-#undef access
-
- result = access(path, mode);
-
- if (result == 0) {
- if (mode & 1) {
- if (GetFileAttributes(path) & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Directories are always executable.
- */
-
- return 0;
- }
- p = strrchr(path, '.');
- if (p != NULL) {
- p++;
- if ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
-
- return 0;
- }
- }
- errno = EACCES;
- return -1;
- }
- }
- return result;
-}
-
diff --git a/win/tclsh.rc b/win/tclsh.rc
deleted file mode 100644
index 098ec86..0000000
--- a/win/tclsh.rc
+++ /dev/null
@@ -1,36 +0,0 @@
-// RCS: @(#) $Id: tclsh.rc,v 1.2 1998/09/14 18:40:20 stanton Exp $
-//
-// Version
-//
-
-#define RESOURCE_INCLUDED
-#include <tcl.h>
-
-VS_VERSION_INFO VERSIONINFO
- FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
- FILEFLAGSMASK 0x3fL
- FILEFLAGS 0x0L
- FILEOS 0x4L
- FILETYPE 0x1L
- FILESUBTYPE 0x0L
-BEGIN
- BLOCK "StringFileInfo"
- BEGIN
- BLOCK "040904b0"
- BEGIN
- VALUE "FileDescription", "Tclsh Application\0"
- VALUE "OriginalFilename", "tclsh" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) ".exe\0"
- VALUE "CompanyName", "Sun Microsystems, Inc\0"
- VALUE "FileVersion", TCL_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
- VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
- VALUE "ProductVersion", TCL_PATCH_LEVEL
- END
- END
- BLOCK "VarFileInfo"
- BEGIN
- VALUE "Translation", 0x409, 1200
- END
-END
-
generated by cgit v0.12 at 2024-11-23 10:22:10 (GMT)